<div id='wikitext'>
<pre><b> File: RTFPP.PA of Tape: Sources/RTS/s3</b></pre>
<pre><b>(Source file text) </b></pre>
<hr />
<pre>
/FPP INTERPRETER TASK
/EAE FLOATING POINT INTERPRETER
/FOR PDP8/E WITH KE8-E EAE

/W.J. CLOGHER, R.LARY, MODIFIED BY W.V.D. MARK FOR RTS8
/FILENAME: RTFPP.PA

CUR=	10

AC7775=	STA CLL RTL
AC7776=	STA CLL RAL
AC4000=	CLA STL RAR
AC3777=	STA CLL RAR
AC2000=	CLA STL RTR
AC0002=	CLA STL RTL

/DEFINITIONS OF KE-8/E INSTRUCTIONS

MQL=	7421
MQA=	7501
CAM=	CLA MQL
SWP=	MQA MQL
SWAB=	7431
SCA=	7441
MUY=	7405
DVI=	7407
NMI=	7411
SHL=	7413
ASR=	7415
LSR=	7417
ACS=	7403
SAM=	7457
DAD=	7443
DLD=	7663
DST=	7445
DPIC=	7573
DCM=	7575
DPSZ=	7451
SGT=	6006

/FPP OPCODES:

FLDA=	0000
FADD=	1000
FSUB=	2000
FDIV=	3000
FMUL=	4000
FADDM=	5000
FSTA=	6000
FMULM=	7000
		LONG=	400	/TWO-WORD ADDRESSING
		BASE=	200	/BASEPAGE ADDRESSING
		IND=	600	/INDIRECT ADDRESSING

FEXIT=	0000
FNORM=	0004
STARTF=	0005
STARTD=	0006
JAC=	0007
XTA=	0030
STARTE=	0050
LDX=	0100

JA=	1030
JNE=	1040
TRAP3=	3000
	*100
T,	0	/TEMPORARY
DFLG,	0	/0 = F.P., 1 = D.P.
FPNXT,	ICYCLE		/USED AS INTERPRETER ADDRESS IF NO FPP
OPCODE,	0		/CHUNKS OF INSTRUCTION
AUTO,	0
INDX,	0
PCHI,	0		/UPPER 3 BITS OF ADRESSES
BASHI,	0
XRHI,	0
ADRHI,	0
DFCUR,	0
DFREL,	0
/FPP PARAMETER TABLE LOCATIONS:

AC0,	0
AC1,	0		/FLOATING AC OVERFLOW WORD
AC2,	0		/OPERAND OVFLOW WORD
OPL,	0
OPH,	0		/*** FLOATING OPERAND REGISTER ***
OPX,	0
EAC3,	0
EAC2,	0		/** FOR EXTENDED PRECISION OPTION **
EAC1,	0
ACL,	0
ACH,	0		/*** FLOATING ACCUMULATOR ***
ACX,	0
ADR,	0
BASADR,	0		/FPP BASE PAGE ADDRESS
XRBASE,	0		/FPP INDEX REGISTER ARRAY ADDRESS
PC,	0		/FPP PROGRAM COUNTER
APT,	0		/VARIOUS FIELD BITS FOR FPP

	PAGE

/MAIN INTERPRETER LOOP

NEGFAC,	DLD		/DO IT THE QUICK WAY
		ACL
	DCM
	DST
		ACL
ICYCLE,	CLA CLL
	JMS I	(FETPC	/GET INST
	SWAB		/ALL IN MODE B
	MQA		/&#039;SWAB&#039; DID &#039;MQL&#039;
	DCA	INST
	SHL		/DECODE INST IN MQ
		3
	DCA	OPCODE	/0-2 = OPCODE
	SHL
		2
	TAD	CODJMP	/3-4 = WORD MODE
	DCA	JMPCOD	/BUILD JMP
	SHL
		1
	DCA	AUTO	/5 = AUTO-INDEX
	SHL
		3
	DCA	INDX	/6-8 = USUALLY INDEX REGISTER
	SHL
		3
	DCA	ADRHI	/9-12 = USUALLY UPPER ADRESS
JMPCOD,	HLT		/JUMP TO - LNK=0,MQ=0
CODLST,	SPECAL		/SPECIAL INSTRUCTIONS
	BPAGE		/BASE PAGE ADRESSING
	LONGI		/TWO WORD ADRESSING
	BPAGEI		/INDIRECT ADRESSING
CODJMP,	JMP I	CODLST
BPAGE,	TAD	DFLG	/CHECK IF DOUBLE INTEGER MODE
	SMA SZA CLA
	STL		/YES - ADD 1 TO ADRESS
	TAD	INST
	RAL
	TAD	INST	/MULTIPLY BASE OFFSET BY 3
	TAD	(200	/ELIMINATE ANY
	AND	(777	/HIGH ORDER BITS
	TAD	BASADR	/ADD IN BASE PAGE ORIGIN
	DCA	ADR
	TAD	BASHI
OPJMPI,	JMS I	(SETDF	/CDF TO BASE PAGE FIELD
	TAD	OPCODE
	TAD	BASJMP	/BUILD JUMP
	DCA	OPJMP
OPJMP,	HLT		/JMP I EXECUTION ROUTINE
BASJMP,	JMP I	FFJMPS

BPAGEI,	TAD	ADRHI
	CLL CML RAL
	TAD	ADRHI	/FORM 3*OFFSET+1
	TAD	BASADR
	DCA	ADR
	TAD	BASHI
	JMS I	(SETDF	/FORM PROPER CDF
	TAD I	ADR	/GET FIELD BITS OF REAL ADDRESS
	AND	(7
	DCA	ADRHI	/FROM 2D WORD OF BASE PAGE LOC
	ISZ	ADR
	SKP
	JMS I	(DFBUMP	/WATCH FOR FIELD OVERFLOW
	TAD I	ADR	/GET LOW-ORDER ADDRESS FROM 3D WORD
			/NOW GO DO INDEXING (IF ANY)

INDEX,	DCA	ADR
	TAD	INDX
	SNA		/IS XR NUMBER 0?
	JMP	NOINDX	/YES - NO INDEXING
	JMS	DCDIDX	/GET XR VALUE (MAYBE INCREMENTED)
	AC7775
	TAD	DFLG	/GET -3 IF F, -2 IF D, -6 IF E MODE
	DCA	DCDIDX
XRADLP,	CLL
	TAD	ADR
	TAD I	T
	SZL
	ISZ	ADRHI
	ISZ	DCDIDX	/ADD THE XR IN THE PROPER NUMBER OF TIMES
	JMP	XRADLP
	DCA	ADR	/IF LNK SET INC FIELD
NOINDX,	CLL
	TAD	ADRHI
	JMP	OPJMPI
LONGI,	JMS I	(FETPC	/NEXT INST WORD CONTAINS LOW-ORDER ADDRESS
	JMP	INDEX

DCDIDX,	0
	JMS I	(SETXR	/ADD IN BASE ADDRESS OF XR ARRAY
	TAD I	T	/T SET BY SETXR
	TAD	AUTO	/INCREMENT BIT ON?
	DCA I	T	/YES - BUMP XR
	JMP I	DCDIDX

FFJMPS,	FFGET		/FOR F,D AND E MODE
	FFADD
	FFSUB
	FFDIV
	FFMPY
	FFADM
	FFPUT
	FFMPM

INST,	0

	PAGE
/MORE I CYCLE

SPECAL,	TAD	OPCODE
	TAD	AUTO
	SNA CLA
	JMP	XROPR	/GO TO XR OR OPERATE CLASS
	JMS I	(FETPC
	DCA	ADR	/DOUBLE WORD SPECIAL
	TAD	OPCODE
	TAD	SPCJMP
	DCA	.+1
	HLT
SPCJMP,	JMP I	SPCLST
SPCLST,	LDADX
	JUMPS
	JXN
	TRAP3I
	TRAP4I
	TRAP5I
	TRAP6I
	TRAP7I

XROPR,	TAD	INDX
	SNA
	JMP	OPRT	/GO TO OPERATES
	TAD	XRJMP
	DCA	XRGO
	TAD	ADRHI	/HERE ADRHI IS INDEX
	JMS	SETXR	/SET &#039;T&#039; AND FIELD
XRGO,	HLT
XRJMP,	JMP I	XRLST-1	/NO INDEX=0 HERE
XRLST,	ALN
	ATX
	FPXTA
	ICYCLE
	STRTE
	ICYCLE
	ICYCLE
OPRT,	TAD	ADRHI	/HERE ADRHI IS SUB OPCODE
	TAD	OPRJMP
	DCA	.+1
	HLT
OPRJMP,	JMP I	OPRLST
JEXTRA,	TAD	MIN4
	TAD	INDX	/0-3 SUB CODE VALID
	SMA
	CLA		/EXIT ON ERROR
	JMP	OPRT+1
MIN4,	-4

	SETX
	SETB
	JSA
	JSR
OPRLST,	EXIT
	FPAUSE
	CLFAC
	NEGFAC
	NRMFAC
	STRTF
	STRTD
	FPJAC

/JUMP DECODER

JUMPS,	TAD	AUTO
	SZA CLA		/IF NOT COND. JUMP, DECODE FURTHER
	JMP	JEXTRA
	TAD	INDX
	TAD	SKPTBL
	DCA	T	/INDEX INTO CONDITIONAL SKIP TABLE
	TAD I	T
	DCA	CNDSKP
	TAD	ACH
	SZA
	JMP	CNDSKP
	TAD	ACL
	SZA CLA		/IF HIGH ORDER ZERO, AC MIGHT BE UNNORMALIZED.
	IAC		/USE LOW ORDER ON 0/NOT 0 BASIS
CNDSKP,	HLT		/TEST AC
	JMP I	FPNXT	/FAILED - DON&#039;T JUMP
	JMP	DOJMP

SKPTBL,	CNDSKT
CNDSKT,	SZA CLA		/JEQ
	SPA CLA		/JGE
	SMA SZA CLA	/JLE
	SKP CLA		/JA
	SNA CLA		/JNE
	SMA CLA		/JLT
	SPA SNA CLA	/JGT
	JMP	TSTALN	/JAL

TSTALN,	CLA
	TAD	ACX
	TAD	MIN27
	SPA SNA CLA
	JMP I	FPNXT
	JMP	DOJMP
MIN27,	-27

JXN,	TAD	INDX	/GET XR FIELD
	JMS I	(DCDIDX	/GET XR VALUE WITH INCREMENTING
	TAD I	T
	SNA CLA		/ZERO?
	JMP I	FPNXT	/YES
			/JUMP ON INDEX NON-ZERO, RIGHT?
DOJMP,	TAD	ADR
	DCA	PC
	TAD	ADRHI
	DCA	PCHI
	JMP I	FPNXT

LDADX,	TAD	ADRHI
	JMS	SETXR
	TAD	INDX
	CLL RAR
	SZA CLA
	JMP I	OPRLST	/EXIT ON ERROR
	SZL
	TAD I	T
	TAD	ADR
	DCA I	T
	JMP I	FPNXT

SETXR,	0
	TAD	XRBASE
	DCA	T
	TAD	XRHI
	JMS I	(SETDF
	JMP I	SETXR

SETX,	TAD	ADRHI	/SET XR0 LOC
	DCA	XRHI
	TAD	ADR
	DCA	XRBASE
	JMP I	FPNXT

	PAGE
FETPC,	0		/LINK MUST = 0
	TAD	PCHI
	JMS	SETDF
	TAD I	PC
	CDF CUR
	ISZ	PC
	JMP I	FETPC
	ISZ	PCHI
	JMP I	FETPC

SETDF,	0
	SZL		/LNK SET MEANS NEXT FIELD
	IAC
	DCA	DFCUR	/VIRTUAL FIELD BITS IN USE
	TAD	DFCUR
	CLL RTL
	RAL
	TAD	DFREL	/CDF 0 OR A RELOCATED FIELD CDF
	DCA	.+1
	HLT
	JMP I	SETDF	/&#039;SETDF&#039; CLEARS LINK

DFBUMP,	0		/PRESERVES AC, CLEARS LINK
	DCA	FETPC
	TAD	DFCUR
	STL		/INC FIELD
	JMS	SETDF
	TAD	FETPC
	JMP I	DFBUMP

SETB,	TAD	ADRHI
	DCA	BASHI
	TAD	ADR
	DCA	BASADR
	JMP I	FPNXT
/MISCELLANEOUS JUMP CLASS INSTRUCTIONS

JSA,	TAD	ADR
	DCA	T
	TAD	ADRHI
	JMS	SETDF	/SET UP LOC TO SAVE PC IN
	AC0002
	TAD	ADR
	DCA	ADR	/BUMP ADDRESS BY 2
	SZL
	ISZ	ADRHI
JSAR,	TAD	PCHI	/JSA/JSR COMMON CODE
	TAD	(JA	/FORM &quot;JA&quot; INSTRUCTION
	DCA I	T
	ISZ	T
	SKP
	JMS	DFBUMP	/BUMP TARGET ADDRESS
	TAD	PC
	DCA I	T
	JMP I	(DOJMP	/NOW JUMP TO DESTINATION

JSR,	CLA CLL IAC
	TAD	BASADR
	DCA	T
	TAD	BASHI
	JMS	SETDF	/SET DF&amp;T TO BASE PAGE LOC +1
	JMP	JSAR

FPJAC,	TAD	ACL
	DCA	ADR
	TAD	ACH
	AND	(7
	DCA	ADRHI
	JMP I	(DOJMP
FPXTA,	TAD	(27	/XR TO AC - NORMALIZE IF FLOATING MODE
	DCA	ACX
	TAD I	T
CLFAC,	DCA	ACL
	TAD	ACL
	SPA CLA
	CLA CMA
	DCA	ACH
NRMFAC,	TAD	DFLG
	SPA SNA CLA
	JMS I	(FFNOR
	JMP I	FPNXT

STRTE,	TAD	DFLG
	SPA CLA
	JMP	.+4	/CLEAR EXTENDED FAC
	DCA	EAC1	/IF NOT ALREADY IN E MODE
	DCA	EAC2
	DCA	EAC3
	TAD	(-4
STRTD,	IAC
STRTF,	DCA	DFLG
	JMP I	FPNXT

ATX,	TAD	ACL
	MQL
	TAD	DFLG	/ATX WORKS DIFFERENTLY IN D.P.I. MODE
	SMA SZA CLA
	JMP	SPCATX
	JMS I	(FFNOR
	STA		/ANSWER IS RETURNED IN INTEG
	TAD	ACX	/ABS(FAC) MUST BE LESS THAN 2048
	CLL		/DETERMINE IF FAC EXPONENT IS
	TAD	(-13	/BETWEEN 1 AND 13
	SZA
	JMP	FIXIT
	TAD	ACH
	SHL
		1
	JMP	FIX0
FIXIT,	CMA
	DCA	FIXSH	/SHIFT COUNT BETWEEN 0 AND 12
	SZL
	JMP	FIX0	/NOT INTEGERIZABLE
	TAD	ACH
	ASR
FIXSH,	0
FIX0,	MQL
	TAD	ADRHI
	JMS I	(SETXR
SPCATX,	MQA CLA
	DCA I	T
	JMP I	FPNXT

FTEMP,	0;0;0

	PAGE
ALN,	TAD	ACX	/ALIGN SIMULATOR
	DCA	OPX	/SAVE EXPONENT IN CASE WE&#039;RE IN D.I. MODE
	TAD	DFLG
	SMA SZA CLA
	DCA	ACX	/ZERO EXP IF D.I. MODE
	TAD	ADRHI
	TAD	DFLG	/IF WE&#039;RE IN FLOATING POINT MODE,
	SNA CLA		/AND DOING AN &quot;ALN 0&quot;,
	TAD	(27	/ALIGN UNTIL EXPONENT = 23
	SNA
	TAD I	T	/OTHERWISE ALIGN UNTIL EXPONENT = XR VALUE
	CDF CUR
	CIA
	TAD	ACX
	SMA		/IF EXPONENT IS LARGER THEN DESIRED EXPONENT,
	JMP	ALNSHL	/SHIFT LEFT
	JMS	ACSR	/OTHERWISE SHIFT RIGHT
ALNXIT,	CAM
	TAD	DFLG
	SPA SNA CLA	/IF DOUBLE INTEGER MODE,
	JMP I	FPNXT
	TAD	OPX	/ALIGNMENT LEAVES THE EXPONENT UNCHANGED
	DCA	ACX
	JMP I	FPNXT
ALNSHL,	MQL		/STORE SHIFT COUNT
	MQA
	CIA
	TAD	ACX
	DCA	ACX
	JMS	SHFTES
	DCA	ALNSHF
	SWP
	SPA
	JMP	ALNOK
	SZA CLA
	JMP	ALNSHF+1
	TAD	ACL
	JMP	.+3
ALNOK,	DLD
		ACL
	SHL
ALNSHF,		0
	DST
		ACL
	JMP	ALNXIT

SHFTES,	0
	MQA
	TAD	(-14
	SPA
	JMP	SHFLOD
	MQL
	MQA
	TAD	(-14
	SPA CLA
	STA CLL
	IAC CLL
SHFLOD,	SWP		/STATUS IN MQ:
	JMP I	SHFTES	/OK= -, BAD=+, 12 BIT=0

ACSR,	0
	CIA
	MQL
	MQA
	TAD	ACX
	DCA	ACX
	JMS	SHFTES
	DCA	SRSHFT
	SWP
	SPA
	JMP	SROK
	SZA CLA
	JMP	SRSHFT+1
	TAD	ACH
	MQL
	MQA
	SPA CLA
	CMA
	JMP	.+3
SROK,	DLD
		ACL
	ASR
SRSHFT,		0
	DST
		ACL
	JMP I	ACSR

/GENERAL AC-TO-MEMORY INTERPRETER
FFMPM,	TAD	(3000	/OP4 - FFMPY
FFADM,	TAD	(3000	/OP1 - FFADD
	TAD	DFCUR	/ADD IN VIRTUAL FIELD BITS
	TAD	KLUDGM
	DCA	OPM
	TAD	ADR	
	DCA	AD1
	TAD	DFCUR
	TAD	KLUDGM
	DCA	PUTM	/FORM FSTA X INSTRUCTION
	TAD	ADR
	DCA	AD2
	JMS I	(FPGO	/MUST RESET TO DF CUR AND INHIBIT
	KLUDGM		/PRIORITY EXIT
	JMP I	FPNXT
KLUDGM,	FSTA+LONG
	FTEMP		/SAVE AC
OPM,	0
AD1,	0		/PERFORM OP
PUTM,	0
AD2,	0		/STORE RESULT
	FLDA+LONG
	FTEMP		/RESTORE AC
	FEXIT

DADDIT,	DLD
		OPL
	DAD
		ACL
	DST
		ACL
	JMP I	FPNXT

	PAGE
/FLOATING ADD AND SUBTRACT-IN ORDER NOT TO LOSE BITS,
/WE DO NOT SHIFT BOTH NUMBERS RIGHT 1 BIT BEFORE ADD-
/ONLY SHIFTS DONE ARE TO ALIGN EXPONENTS.

FFSUB,	JMS	ARGET
	DCM		/NEGATE OPERAND
	DST
	OPL
	SKP

FFADD,	JMS	ARGET	/PICK UP ARGUMENTS
	DPSZ
	SKP CLA
	JMP I	FPNXT
	TAD	DFLG
	SMA SZA CLA
	JMP I	(DADDIT	/GO DO D.P. ADDITION
	TAD	ACH
	SZA CLA
	JMP	ADOK
	TAD	OPH
	JMP	ADON
ADOK,	TAD	OPX	/PICK UP EXPONENT OF OPERAND
	MQL		/SEND IT TO MQ FOR SUBTRACT
	TAD	ACX	/GET EXPONENT OF FAC
	SAM		/SUBTRACT-RESULT IN AC
	SMA		/NEGATIVE RESULT?
	CMA	IAC	/NO-MAKE IT NEGATIVE
	DCA	AC0	/STORE IT AS A SHIFT COUNT
	TAD	ACX	/GET FAC EXP.INTO AC
	SGT		/WHICH EXPONENT WAS GREATER?
	DCA	OPX	/FAC&#039;S-STORE FINAL EXP. IN OPX
	SGT		/WHICH EXP GREATER(GT FLG SET
			/BY SUBTR. OF EXPS.)
	SKP CLA
	JMP	NOSWAP
	TAD	ACH	/SWAP AC AND OP
	MQL
	TAD	OPH
	DCA	ACH
	MQA
	DCA	OPH
	TAD	ACL
	MQL
	TAD	OPL
	DCA	ACL
	MQA
	DCA	OPL
NOSWAP,	AC7776
	DCA	AC2	/SET SWITCH FOR SMALL AC
	TAD	AC0	/GET SHIFT COUNT
	JMS I	(ACSR	/AND SHIFT AC
	DPSZ		/SHIFTED TOO FAR?
	ISZ	AC2	/NO - SKIP NEXT ISZ
	DAD
		OPL	/ADD IN OP (OR LOAD ONLY)
	ISZ	AC2	/COULD EXPONENTS BE ALIGNED?
	JMP	ADON	/NO-JUST LEAVE LARGER IN AC,MQ
	DCA	ACH
	TAD	ACH
	SZL		/OVERFLOW?(L NOT = SIGN BIT)
	CMA		/NOTE-WE DIDN&#039;T SHIFT BOTH RIGHT 1
	AND	EMSIGN	/SEE IF 2 #S HAD SAME SIGN
	SPA	CLA
	JMP	OVRFLO	/YES-OVERFLOW
	AC4000
	TAD	ACH	/NO-GET HIGH ORDER RESULT BACK
			/CHECK FOR 4000 0000 MANTISSA
	DPSZ		/IT WILL BE SET TO 0 BY NMI
	JMP	ADON-1	/OK-RESTORE NUMBER
	AC2000		/GOT A 4000 0000-SET TO 6000 0000
DOIT,	ISZ	OPX	/AND INCREMENT EXPONENT
	NOP
	TAD	(4000	/RESTORE NUMBER
ADON,	NMI		/NORMALIZE (LOW ORDER STILL IN MQ)
	DST		/STORE FINAL RESULT
		ACL
	CLA SCA		/GET SHIFT COUNTER(# OF NMI SHIFTS)
	CIA		/NEGATE IT
	TAD	OPX	/AND ADJUST FINAL EXPONENT
	DCA	ACX
	JMP I	FPNXT	/RETURN
OVRFLO,	TAD	ACH	/OVERFLOW-GET HIGH ORDER RESLT BACK
	ASR		/SHIFT IT RIGHT 1
		1
	JMP	DOIT
/DOUBLE PRECISION INTEGER OPCODE INTERPRETERS

EMSIGN,	0
ARGET,	0		/SUBROUTINE TO FETCH ARG FOR ADD, SUBT, ETC.
	TAD	DFLG	/CHECK D.P.
	SMA SZA CLA
	JMP	DARGET	/YES
	TAD I	ADR	/PICK UP EXPONENT
	ISZ	ADR	/MOVE POINTER TO HI MANTISSA WD
	SKP
	JMS I	(DFBUMP
	SKP
DARGET,	DCA	ACX
	DCA	OPX
	TAD I	ADR	/PICK IT UP
	MQL
	MQA		/TEMPORARY
	AND	(4000	/SIGN OF OP
	TAD	ACH	/+SIGN OF AC
	SMA CLA
	CMA
	DCA	EMSIGN	/SET SIGN RESULT
	ISZ	ADR	/MOVE PTR. TO LO MANTISSA WD.
	SKP
	JMS I	(DFBUMP	/WATCH THOSE FIELD TRANSITIONS!
	TAD I	ADR	/PICK IT UP
	CDF CUR		/SET FIELD OF FPP
	SWP
	DST		/STORE REVERSE
		OPL	/AND KEEP IN AC,MQ
	JMP I	ARGET	/RETURN
/ROUTINE TO NORMALIZE THE FAC

FFNOR,	0
	CDF CUR
	DLD		/PICK UP MANTISSA
	ACL
	NMI		/NORMALIZE IT
	SNA		/IS THE # ZERO?
	DCA	ACX	/YES-INSURE ZERO EXPONENT
	DST		/STORE BACK
		ACL
	CLA	SCA	/STEP COUNTER TO AC
	CMA	IAC	/NEGATE IT
	TAD	ACX	/AND ADJUST EXPONENT
	DCA	ACX
	JMP I	FFNOR	/RETURN

	PAGE
/FLOATING MULTIPLY--DOES 4 SINGLE MULTIPLIES WITH EAE
/THIS USES THE FACT THAT IF AC IS NON-ZERO WHEN YOU DO
/A MUY INSTR, THE AC IS ADDED TO RESULT OF THE MULTIPLY.
/(IN THE LOW ORDER, NATCHERLY)

FFMPY,	JMS I	(ARGET
	JMS	EMDSET	/SET UP FOR MULT
	CLA	MUY	/MULTIPLY-LOW ORDER FAC STILL IN MQ
	OPL		/THIS IS PRODUCT OF LOW ORDERS
	MQL		/ZAP LOW ORDER RESULT-INSIGNIFICANT
	TAD	ACL	/GET LOW ORDER OF FAC
	SWP	MUY	/TO MQ-HIGH ORD. RESLT OF LAST MPY
	OPH		/TO AC-WILL BE ADDED TO RESLT-THIS
	DST		/IS PRODUCT-LOW ORD FAC,HI ORD OP
	AC0		/STORE RESULT
	DLD		/HIGH ORDER FAC TO MQ
	ACH		/FAC EXPONENT TO AC
	TAD	OPX	/ADD OPERAND EXPONENT-GET SUM OF EXPS.
	DCA	ACX	/STORE RESULT
	MUY		/MUL. HIGH ORDER FAC BY LOW ORD OP.
	OPL		/HIGH ORDER FAC WAS IN MQ
	DAD		/ADD IN RESULT OF SECOND MULTIPLY
	AC0
	DCA	AC1	/STORE HIGH ORDER RESULT
	TAD	ACH	/GET HIGH ORDER FAC
	SWP		/SEND IT TO MQ AND LOW ORD. RESULT
	DCA	AC0	/OF ADD TO AC-STORE IT
	RAL		/ROTATE CARRY TO AC
	DCA	AC2	/STORE AWAY
	MUY		/NOW DO PRODUCT OF HIGH ORDERS
	OPH		/FAC HIGH IN MQ, OP HIGH IN OPH
	DAD		/ADD IN THE ACCUMULATED #
	AC1
/MULTIPLIES DONE - MASSAGE RESULT

	SNA		/ZERO?
	JMP	RTZRO	/YES-GO ZERO EXPONENT
	NMI		/NO-NORMALIZE (1 SHIFT AT MOST!)
	DCA	ACH	/STORE HIGH ORDER RESULT
	CLA	SCA	/GET STEP CNTR-DID WE NEED A SHIFT?
	SNA	CLA
	JMP	SNCK	/NO-JUST CHECK SIGN
	TAD	AC0	/YES - WATCH OUT FOR LOST ACCURACY!
	RAL
	DCA	AC0
	SZL		/IF HIGH ORDER BIT OF OVERFLOW WORD WAS ON,
	DPIC		/TURN MQ11 ON (IT WAS 0 FROM THE NMI)
	CLA	CMA	/MUST DECREASE EXP. BY 1
TADACX,	TAD	ACX
RTZRO,	DCA	ACX	/STORE BACK
SNCK,	TAD	AC0
	SPA	CLA	/IS HIGH ORDER OF OVERFLO WD. 1?
	DPIC		/YES-ADD 1 TO LOW ORDER-STILL IN MQ
	TAD	ACH
	SMA
	JMP	EMDONE	/WE DIDN&#039;T OVERROUND - GOODY
	LSR
	1		/BUT OVERROUNDING IS EASILY CORRECTED!
	ISZ	ACX	/    (OVERCORRECTED??)
	NOP

/COMMON CLEANUP ROUTINE FOR MULTIPLY AND DIVIDE

EMDONE,	ISZ I	(EMSIGN	/SHOULD SIGN BE MINUS?
	DCM		/YES-DO IT
	SNA
	DCA	ACX	/FORCE EXPONENT 0 IF MANTISSA = 0
	DST		/STORE IT BACK
	ACL
	CLA
	TAD	DFLG
	SMA SZA CLA
	TAD	ACX	/IF D.P. INTEGER MODE AND ACX LESS THAN 0,
	SPA		/GO TO UNNORMALIZE RESULT
	JMS I	(ACSR
	JMP I	FPNXT	/OTHERWISE BUMP RETN. AND RETN.
/ROUTINE TO SET UP FOR MULTIPLY AND DIVIDE

EMDSET,	0
	SPA		/MANTISSA OF OP. IN AC,MQ
	DCM		/IF NEGATIVE-NEGATE IT
	SHL		/SHIFT OPRND LEFT 1 TO AVOID OVRFLO
	1
	DST		/STORE BACK
	OPL
	DLD
	ACL
	SPA		/FAC LESS THAN 0?
	DCM		/YES-NEGATE
	DST		/STORE BACK
	ACL
	JMP I	EMDSET
/COMBINED PUT AND GET FAC

FFGET,	AC2000
FFPUT,	DCA	AC0	/2000 FOR DCA
	AC7775
	TAD	DFLG
	DCA	AC1	/SET SIZE OF FAC
	TAD	DFLG	/6,3 OR 2
	SMA SZA CLA
	CMA		/ADRESS ONE LESS FOR D.P.
	TAD	AC0
	TAD	TADACX	/EITHER TAD OR DCA
	DCA	PGINST	/FOR PUT OR GET
PGLOOP,	TAD	AC0
	CLL RTL
	SZL
	TAD I	ADR	/GET
PGINST,	HLT
	SNL
	DCA I	ADR	/PUT
	ISZ	ADR
	SKP
	JMS I	(DFBUMP
	STA
	TAD	PGINST
	DCA	PGINST
	ISZ	AC1
	JMP	PGLOOP
	JMP I	FPNXT

	PAGE
/FLOATING DIVIDE

FFDIV,	JMS I	(ARGET
	JMS I	(EMDSET	/GET ARG. AND SET UP SIGNS
	DVI		/DIVIDE-ACH AND ACL IN AC,MQ
	OPH		/THIS IS HI ORDER DIVISOR
	DST		/QUOT TO AC0,REM TO AC1
	AC0
	SZL	CLA	/DIVIDE ERROR?
	JMP	DBAD	/YES - HANDLE IT
	TAD	OPX	/DO EXPONENT CALCULATION
	CMA	IAC	/EXP. OF FAC - EXP. OF OP
	TAD	ACX
	DCA	ACX
	DPSZ		/IS QUOT = 0?
	SKP		/NO-GO ON
	DCA	ACX	/YES-ZERO EXPONENT
	MUY		/NO-THIS IS Q*OPL*2**-12
	OPL
	DCM		/NEGATE IT
	TAD	AC1	/SEE IF GREATER THAN REMAINDER
	SNL
	JMP	EDVOPS	/YES-ADJUST FIRST DIVIDE
	DVI		/NO-DO Q*OPL*2**-12/OPH
	OPH
	SZL	CLA	/DIV ERROR?
	JMP	DBAD	/YES
DVLP1,	TAD	AC0	/NO-GET QUOT OF FIRST DIV.
	SMA		/NEGATIVE?
	JMP I	(EMDONE	/NO-REMEMBER-QUOT OF 2ND DIV. IN MQ
	LSR		/YES-MUST SHIFT IT RIGHT 1
	1
	ISZ	ACX	/ADJUST EXPONENT
	NOP
	SGT		/TEST SHIFTED OUT BIT
	JMP I	(EMDONE	/ZERO - NO ROUND
	DPIC		/BUMP AC FRACTION
	JMP	DVLP1+1	/MAYBE SHIFT AGAIN
/CONTINUATION OF DIVIDE ROUTINE
/WE ARE ADJUSTING THE RESULT OF THE
/FIRST DIVIDE.

EDVOPS,	CMA	IAC	/DCM?
	DCA	AC1	/ADJUST REMAINDER
	TAD	OPH	/WATCH FOR OVERFLOW
	CLL CMA IAC
	TAD	AC1
	SNL
	JMP	DVOP1	/DON&#039;T ADJUST QUOT.
	DCA	AC1
	CMA
	TAD	AC0
	DCA	AC0	/REDUCE QUOT BY 1
DVOP1,	CLA	CLL
	TAD	AC1	/GET REMAINDER
	SNA		/ZERO?
	CAM		/YES-ZERO EVERYTHING
	DVI		/NO
	OPH
	SZL	CLA	/DIV. OVERFLOW?
	JMP	DBAD	/YES
	DCM		/NO-ADJUST HI QUOT (MAYBE)
	JMP	DVLP1	/GO BACK

DBAD,	TAD	DBAD	/ERROR ROUTINE?
	DCA	ACX	/SET AC TO LARGE POS.NUM.
	AC2000
	JMP I	(EMDONE
/FPP INTERPRETER STARTUP ROUTINE

FPGO,	0
FPGCDF,	CDF CUR		/NECESSARY?
	CLA
	TAD	PC
	DCA	SAVPC	/ALLOW ONE LEVEL OF RECURSIVENESS
	TAD	PCHI
	DCA	SVPCHI
	TAD	DFREL
	DCA	SAVREL
	TAD I	FPGO
	DCA	PC
	ISZ	FPGO
	DCA	PCHI
	TAD	FPGCDF	/FPGO STARTS UP THE FPP
	DCA	DFREL	/FROM FIELD CUR ONLY
	JMP I	FPNXT

TRAP5I,
TRAP6I,
TRAP7I,
FPAUSE,
EXIT,	TAD	SAVPC
	DCA	PC
	TAD	SVPCHI
	DCA	PCHI	/RESTOTE OLD 15-BIT PC
	TAD	SAVREL
	DCA	DFREL	/RESTORE OLD VIRTUAL FIELD
	JMP I	FPGO	/RETURN TO PDP-8 CODE
SAVPC,	0
SVPCHI,	0
SAVREL,	0
/MISCELLANEOUS OPCODE ROUTINES

TRAP3I,
TRAP4I,	AC0002
	TAD I	(DFREL
	DCA	.+1	/FORM CDF CIF N
	HLT		/EXECUTE IT
	TAD I	(INST
	SMA CLA		/TRAP4 JMS&#039;S TO ITS TARGET ADDRESS,
	JMP I	ADR	/TRAP3 JMP&#039;S TO IT
	JMS I	ADR
	JMP I	FPNXT

	PAGE

	$$$
</pre>
<hr/>
</div>