<div id='wikitext'>
<pre><b> File: M3FPP.PA of Tape: Sources/Multi8/multi8-2</b></pre>
<pre><b>(Source file text) </b></pre>
<hr />
<pre>
/M3FPP.PA 19-JUN-80

XLIST -LFPP-1&amp;XLISTX
/FPP8A EMULATOR

IFDEF FPP &lt;

	/ DEFINITIONS:
	CLSR=6140	/ CLEAR SHIFT REGISTER
	SKFR=6141	/ SKP IF FPP IC READY
	SKFE=6142	/ SKIP IF FPP ERROR FLAG IS SET
	SKSR=6143	/ SKIP IF SHIFT REGISTER NOT SHIFTING
	SEMO=6144	/ SET MODE, CLEAR FPP READY FLAG
	 MDINTE=4000	/ AC0=1 =: INT. ENABLE ON FPP READY
	 MDEXTD=2000	/ AC1=1 =: 64/72 BIT MODE
	SCAC=6145	/ SHIFT COUNTER TO AC6-11 (BIT 4,5 ALWAYS SET)
	SRAC=6146	/ SHIFT REGISTER TO AC
	NRSR=6147	/ NORMALIZE CONTENTS OF (POSITIVE) SHR
			/ SHIFT LEFT UNTIL MSB IS AT LEFMOST POSITION
			/ THE SHIFT COUNTER HOLDS THE PERFORMED SHIFT COUNT
			/ EXCEPTION: SHR = 4000 =: SHIFT COUNT = 1
	ACSR=6150	/ AC TO SHIFT REGISTER, 0 =: AC
	ACSC=6151	/ AC TO SHIFT COUNTER, 0 =: AC
			/ AC6-11 TO SHIFT COUNTER (AC=0 =: 1 BIT SHIFT)
	 DOWN=4000	/ AC0=1 =: SHIFT DOWN
	 IMPL=2000	/ AC1=1 =: SET IMPLIED BIT
	 LISH=1000	/ AC2=1 =: LINEAR SHIFT (FILL WITH 0)
	SRFP=6152	/ SHIFT REGISTER TO FPP (32 OR 64 BITS, SEE SEMO)
	FPSR=6153	/ FPP TO SHIFT REGISTER (32 OR 64 BITS, SEE SEMO)
	STSR=6154	/ STATUS OF FPP IC TO SHIFT REGISTER (8 LSB)
	LCGO=6155	/ LOAD CMD BYTE INTO FPP IC &amp; GO
			/ THIS CMD WILL DESTROY THE LS 12 BITS 
			/ OF THE SHIFT REGISTER
	SRUP=6156	/ SHIFT UP 12 BITS   (IN RING-MODE)
	SRDN=6157	/ SHIFT DOWN 12 BITS (IN RING-MODE)
/
/	STATUS REGISTER : /BUSY/SIGN/ZERO/RSRV/DIVI/UNDR/OVER/RSRV/
/			    200  100   40   20   10    4    2    1
/
/	NOTE: THE SHIFT REGISTER NEEDS SOME TIME FOR SHIFTING
/	      ~ 150NS PER SINGLE BIT SHIFT
/FPP8A HARDWARE INSTRUCTIONS EMULATION

/EMULATOR DISPATCH FOR FPP8A INSTRUCTIONS
EM55,	TAD (EM55TB-50	/COMPENSATE FOR XX5X
	JMP I (EMLIST	/GO TO DOT PROCESSOR IN M3.PA

FPICL,	JMS	PUT	/CLEAR STATUS
	   UFPST	/THAT WAS EASY
	JMP I	(EMREDY	/NO AC CLEAR

FPCOM,	JMS	GET	/SET APT HIGH AND DP MODE
	   UAC		/GET USER AC
	JMS	PUT
	   UAPTH	/SET EMA BITS OF APT POINTER
	AC4000
	AND I	X	/GET AC0
	JMS	PUT	/
	   UFPST	/SET DP,FP/EP IN STATUS. DP=4000
	JMP I	(EMCLA	/IGNORE ALL OTHER BITS

FPRST,	JMS	GET
	   UFPST	/READ STATUS
	JMP I	(EMCLA	/EASY

FPIST,	JMS	GET
	   UFPST
	MQL
	DCA I	X	/CLEAR IT ALSO
	MQA
	JMS	PUT	/
	   UAC		/STORE STATUS IN AC
	JMP I	(EMSKIP	/CRAZY! IT SKIPS

FPEP,	JMS	GET
	   UAC		/GET AC. ANOTHER CRAZY INSTRUCTION
	CLL RTL		/IF AC=4000 (WHY THIS?)
	RTL		/SET EP MODE
	JMS	PUT	/
	   UFPST	/
	JMP I	(EMCLA

FPST,	JMS	GET	/SET APT LOW AND GO!
	   UPC
	IAC		/THIS INSTRUCTION SKIPS
	DCA I	X	/SO INCREMENT PC
	JMS	GET	/
	   UAC
	TAD	M1	/OPTIMIZATION
	JMS	PUT	/
	   UAPTL	/SET LOW ADDRESS-1 OF APT
			/FALL INTO NEXT PAGE
IFNZRO .&amp;4000 &lt;FPERR, XERROR	/M3 &amp; CO ARE TOO BIG &gt;
FFACT,	JMS	FFSJOB	/AM I INTERACTIVE ?
	TAD	FFFREE	/YES: IS SOMEBODY USING FPP ?
	SNA CLA		/NON-ZERO IS FREE
	 JMP	FFSTAL	/YES, WAIT
	DCA	FFFREE	/OK, HERE WE GO !!
	JMS	GET	/SHOW WE ARE BUSY
	   UFPST	/
	SPA CLA		/WAS IT DP?
	IAC
	DCA	DFLG	/IF DP DFLG=1
	TAD I	X	/
	SPA		/NOT DP?
	 JMP	STSTEN
	AND	C4	/NOT DP, CHECK EP
	SZA CLA		/EP?
	ACM3		/YES, DFLG=-3
	DCA	DFLG	/NO, DFLG=0
STSTEN,	AC2000
	AND	DFLG	/SET CORRECT SHR SIZE
	SEMO
	TAD	BASE	/
	TAD	(UFLD0	/MAKE POINTER TO UFLD TABLE
	DCA I	(FFPFLD	/SETDF USES IT FOR FAST RESPONSE
	JMS I	(APTGET	/NOW LOAD INFO FROM USER BACKGROUND
M8CHK,	JMS I	(CHKM8	/IS MULTI8 WAITING ? (RESET DF 10)
	JMS I	(GETQ	/GET CHAR FROM OUR
	   UBUFIN	/OUR INPUT BUFFER
	AND	C177	/
	TAD	M3	/WAS IT ^C?
	SNA CLA		/
	JMP	FFCTC	/FAKE UNDERFLOW CONDITION ON ^C
	JMS	FFSJOB	/ARE WE STILL INTERACTIVE ?
	JMP I	(FFNOP	/YES, GO ON EMULATING
	JMS I	(UNLOAD	/NO, UNLOAD IC
	JMS I	(APTDMP	/AND DUMP CONTEXT IN USER FIELD
	ISZ	FFFREE	/FREE FPP EMULATOR
FFSTAL,	JMS	MONITOR	/STALL CONCURRENT BG
	   STALL
	   1		/FOR 1 TICK
	JMS	SETBASE	/CLEAR AC, SET BASE,DF 10
	JMP	FFACT	/TRY AGAIN
FFSJOB,	0		/CHECK ON INTERACTIVE PRIORITY
	TAD	BASE	/
	CIA
	CDF 0		/SJOB IS IN F0
	TAD I	(SJOB	/AM I THE INTERACTIVE JOB ?
	CDF 10
	SNA CLA
	 JMP I	FFSJOB	/YES, RETURN 1
	ISZ	FFSJOB
	JMP I	FFSJOB	/NO, RETURN 2

FFCTC,	DCA I	X	/ONE ^C AT A TIME!! DEPENDS ON GETQ !!##!!##!!
	TAD	(40	/SET UNDERFLOW BIT IN STATUS (NOT USED IN FRTS)
	JMP	FFEXIT	/GO BACK TO USER WITH CTRLC ERROR
FFTRP3,
FFTRP4,	AC2000		/SET TRAPBIT IN STATUS
FFPAUS,
FFEXIT,	MQL		//
	CDF 10		/
	JMS	GET	/
	   UFPST	/
	MQA		/
	DCA I	X	/BACK TO STATUS
	JMS I	(UNLOAD	/UNLOAD IC IF NOT YET DONE
	JMS I	(APTDMP	/DUMP ALL IN USER BG
	ISZ	FFFREE	/FREE FPP FOR OTHERS
	JMP I	(EMREDY	/BACK TO NORMAL EMULATOR

FFFREE,	1		/FPP FREE FLAG
	PAGE
SYNC,	0		//CALLED WITH FOREIGN FIELD
	TAD	SYNIC	//DO WE HAVE TO WAIT ?
	SNA CLA		//
	JMP I	SYNC	//NO, WE ALREADY CAME THRU HERE
	RDF		//
	TAD	C6201	//MUST PRESERVE FIELD!
	DCA	SYNEX	//
SYNWT,	JMS I	(CHKM8	/LOOK AT MULTI8 (SETS DF=10)
	SKFR		/READY ?
	JMP	SYNWT	/NO, CHECK AGAIN
	STSR		/STATUS TO SHR
	DCA	SYNIC	/DELAY AND SET NO SYNC
	SRAC		/READ STATUS
	DCA	ICSTAT	/AND KEEP
	AC2000
	AND	DFLG	/SET CORRECT SHR SIZE
	SEMO		/CLEAR FLAG AND
	CLSR		/CLEAR SHR IN CASE OF FAC=0
	TAD	ICSTAT
	AND	C17	/DID WE GET AN ERROR ?
	SZA
	JMP	FFERR	/YES, BUT WHICH ONE ?
	TAD	ICSTAT	/GET STATUS FROM LAST OP AGAIN
	AND	(140	/MASK OUT SIGN=100 AND ZERO=40 BITS
	BSW		/NOW ZERO=4000 AND NEGATIVE=1
	TAD	(4000	/NOW NONZERO=4000 AND NEG=1
	CLL RTR		/NOW NONZERO=1000 AND NEG=4000
SYNCLR,	DCA	ACSGN	/OUR SIGN IS SET
SYNEX,	HLT		//BACK TO OLD FIELD
	JMP I	SYNC	//

FFERR,			/WE HAVE AN ERROR! DIV=10,UNDR=4,OVER=2
	BSW		/DIV=1000,UNDR=400,OVER=200
	CLL RAR		/DIV=400,UNDR=200,OVER=100
	AND	(500	/MASK OUT FATALS DIV AND OVER
	SNA		/WAS IT UNDERFLOW?
	JMP	SYNCLR	/YES, CLEAR FAC AND GO ON
			/OVERFLOW=100,DIVERR=400 BITS OF FPP8A
	JMP I	(FFEXIT	/PUT IN STATUS AND EXIT
UNLOAD,	0		//GETS CALLED WITH FOREIGN FIELD
	JMS	SYNC	//UNLOAD IS REALLY COMBINED SYNC-UNLOAD
	TAD	INIC	//DO WE HAVE TO UNLOAD ?
	SNA CLA
	JMP I	UNLOAD	//NO, ALREADY DONE
	DCA	INIC	//YES, CLEAR UNLOAD FLAG NOW
	CLSR		//CLEAR SHR IN CASE NO SYNC
	TAD	ACSGN	//DID SYNC SHOW FAC=0 ?
	SNA CLA
	JMP I	UNLOAD	//YES, TAKE QUICK EXIT WITH ACSGN =0
	FPSR		//GET DATA FROM IC
	SKSR		//WAIT FOR TRANSFER READY
	 JMP	.-1	//
	TAD	DFLG
	SPA CLA		//FP OR EP?
	 JMP	FFUNEP	//EP
FFUNFP,	TAD	(4+11	//POS EXP
	ACSC
	AND	0	//DELAY
	SRAC		//GET EXP
	AND	(377	//MASK
	TAD	(-176	//DEOFFSET
FFUNEN,	DCA	ACX
	TAD	(DOWN+IMPL+LISH+2
	ACSC		//FINAL POSITION
	ACSR		//CLEAR EXP (NO DELAY)
	TAD	DFLG	//WAS IT DP MODE?
	SPA SNA CLA	//
	JMP I	UNLOAD	//NO, THAT&#039;S ALL
	TAD	(LISH	//YES, FIDDLE
	MQL		//FOR LINEAR SHIFT
	TAD	(27	//IF D.P. INTEGER MODE
	JMS I	(FIXSHF	//GO TO UNNORMALIZE RESULT
	TAD	(27
	DCA	ACX	//AND SET EXPONENT TO STANDARD
	JMP I	UNLOAD	//

FFUNEP,	TAD	(10+14	//POS EXP
	ACSC
	AND I	0	//DELAY
	SRAC		//GET EXP
	AND	(3777	//MASK
	TAD	(-1776	//DEOFFSET
	JMP	FFUNEN	//
FFCOMM,	0		/DOUBLE LOAD AND COMMAND TO IC
	DCA	FFFUNC	/SAVE IC OPCODE
	TAD	INIC	/ALREADY LOADED IN IC ?
	SNA CLA
	JMS I	(FFLOAD	/NO, LOAD FAC IN IC
	JMS I	(FFGET	//GET OPERAND
	JMS I	(FFLOAD	//AND LOAD OPERAND IN IC
	ISZ	INIC	//NOW IT IS LOADED
	AC2000
	AND	DFLG	//BE SURE MODE IS SET
	SEMO		//AND CLEAR FLAG
	TAD	DFLG	//WAS IT EP?
	SPA CLA
	TAD	(50	//YES ADD EPIC MODE
	TAD	FFFUNC	//AND OPERATION
	LCGO
	ISZ	SYNIC	//A FLAG IS COMING UP
	JMP I	FFCOMM	//NOW OVERLAP EMULATION

FFFUNC,	0		/IC FUNCTION
ICSTAT,	0		/IC STATUS
INIC,	0		/IC LOADED FLAG
SYNIC,	0		/IC ACTIVE FLAG

	PAGE
/MAIN INTERPRETER LOOP

FFNOP,	JMS I	(FETPC	/GET INST, RESET DF
	DCA	ADRHI
	TAD	ADRHI
	CLL RTL
	RTL
	SPA SZL		/IS IT SPECIAL ?
	 JMP	BPAGE	/BASE PAGE ACCELERATION
	AND	C7
	DCA	OPCODE	/0-2 = OPCODE
	JMS	ADINAU	/SET SOME REGISTERS
	TAD	OPCODE
	TAD	AUTO
	SNA CLA
	JMP I	(XROPR	/GO TO XR OR OPERATE CLASS
	JMS I	(FETPC
	DCA	ADRLOW	/DOUBLE WORD SPECIAL
	TAD	OPCODE
	TAD	(SPCLST
FFDISP,	CDF 10		/BE SURE
	DCA	DCDIDX
	TAD I	DCDIDX	/LOCAL DEFER
	DCA	DCDIDX
	JMP I	DCDIDX

ADINAU,	0
	TAD	ADRHI
	CLL RTR
	RAR
	AND	C7
	DCA	INDX	/6-8 = USUALLY INDEX REGISTER
	TAD	ADRHI
	AND	C100
	BSW
	DCA	AUTO	/5 = AUTO-INDEX
	JMP I	ADINAU	/RETURN - LNK=0
OPCODE,	0
BPAGE,	SZL		/IS IT REALLY BASE PAGE ?
	 JMP	LNGIND	/NO, EITHER LONG OR INDIRECT
	AND	C7	/CHOP OUT OPCODE
	TAD	(JMS I FFLST
	DCA	OPJMS	/BUILD JMS TO OPERATION
	TAD	ADRHI
	AND	C177
	DCA	DCDIDX	/PICK OUT ADDRESS PART
	TAD	DFLG	/CHECK IF DOUBLE INTEGER MODE
	SMA SZA CLA	/IF NOT, LINK=0
	STL		/YES - ADD 1 TO ADDRESS
	TAD	DCDIDX
	RAL
	TAD	DCDIDX	/MULTIPLY BASE OFFSET BY 3
	TAD	BASADR	/ADD IN BASE PAGE ORIGIN
	DCA	ADRLOW
	RAL
	TAD	BASHI
	DCA	ADRHI
NOINDX,	CDF 10
OPJMS,	HLT
	JMP I	(M8CHK	//GO FOR MORE (RESET DF)

LNGIND,	AND	C7
	TAD	(JMS I FFLST
	DCA	OPJMS	/BUILD JMS TO OP AGAIN
	JMS	ADINAU	/SETUP REGISTERS FOR THESE OPS
	TAD	ADRHI	/WHERE TO GO ?
	AND	C200	/TEST LOW CLASS BIT
	SZA CLA		/IS IT &#039;LONG&#039; ?
	 JMP	BPAGEI	/NO, &#039;INDIRECT&#039;
	JMS I	(FETPC	/NEXT INST WORD CONTAINS LOW-ORDER ADDRESS
INDEX,	DCA	ADRLOW	/HERE WE COME FROM BPAGEI
	JMS	DCDIDX	//SET XR VALUE (MAYBE INCREMENTED)
	TAD	INDX	//
	SNA CLA		//IS XR NUMBER 0?
	JMP	NOINDX	//YES, NO INDEXING
	AC7775		//INDEX DF
	TAD	DFLG	//GET -3 IF F, -2 IF D, -6 IF E MODE
	DCA	DCDIDX	//
	TAD	ADRLOW	//
XRADLP,	CLL		//
	TAD I	XRPNT	//
	SZL		//
	ISZ	ADRHI	//IF LINK SET, INC FIELD
	ISZ	DCDIDX	//ADD THE XR IN THE PROPER NUMBER OF TIMES
	JMP	XRADLP	//
	DCA	ADRLOW	//
	JMP	NOINDX	//
BPAGEI,	TAD	ADRHI
	AND	C7
	DCA	ADRHI
	TAD	ADRHI
	STL RAL
	TAD	ADRHI	/FORM 3*OFFSET+1
	TAD	BASADR
	DCA	ADRLOW
	RAL
	TAD	BASHI
	JMS I	(SETDF	//FORM PROPER CDF
	TAD I	ADRLOW	//GET FIELD BITS OF REAL ADDRESS
	DCA	ADRHI	//FROM 2D WORD OF BASE PAGE LOC
	ISZ	ADRLOW	//
	SKP		//
	JMS I	(DFBUMP	//WATCH FOR FIELD OVERFLOW
	TAD I	ADRLOW	//GET LOW-ORDER ADDRESS FROM 3D WORD
	JMP	INDEX	//NOW GO DO INDEXING (IF ANY)

FFLST,	FFGET		/FOR F,D AND E MODE
	FFADD
	FFSUB
	FFDIV
	FFMPY
	FFADM
	FFPUT
	FFMPM

DCDIDX,	0		/PREINC XR
	TAD	INDX	/
	JMS I	(SETXR	//ADD IN BASE ADDRESS OF XR ARRAY
	TAD I	XRPNT	//XRPNT SET BY SETXR
	TAD	AUTO	//INCREMENT BIT ON?
	DCA I	XRPNT	//YES - BUMP XR
	JMP I	DCDIDX	//
	PAGE
LDADX,	TAD	(LAXLST-XRLST+1
XROPR,	TAD	INDX
	SNA
	JMP	OPRT	/GO TO OPERATES
	TAD	(XRLST-1
	JMS	DEFER
	DCA	FETPC
	TAD	ADRHI	/HERE ADRHI IS INDEX
	JMS I	(SETXR	//SET &#039;XRPNT&#039; AND FIELD
	JMP I	FETPC	//

OPRT,	TAD	ADRHI	/HERE ADRHI IS SUB OPCODE
	AND	C7
	TAD	(OPRLST
	JMP I	(FFDISP

/JUMP DECODER

JUMPS,	TAD	AUTO
	CLL RTL
	RAL
	TAD	INDX
	TAD	(JMPLST
	JMP I	(FFDISP

FFJXN,	JMS I	(DCDIDX	//GET XR VALUE WITH INCREMENTING
	TAD I	XRPNT	//
	SNA CLA		//ZERO?
	JMP I	(FFNOP	//YES.
	JMP	FFJA	//JUMP ON INDEX NON-ZERO, RIGHT?

FFJAL,	JMS I	(UNLOAD
	TAD	ACSGN	/WAS AC=0 ?
	SZA CLA		/AC=0 MEANS EXP=0
	TAD	ACX
	TAD	(-27
	SPA SNA CLA
	JMP I	(FFNOP
	JMP	FFJA

FFJAC,	JMS I	(UNLOAD	/AC=0 IMPOSSIBLE ?
	SRUP		/MOVE TO &#039;ACH&#039;
	NOP		/DELAY
	SRAC		/GET &#039;ACH&#039;
	SRUP		/MOVE TO &#039;ACL&#039;, LET&#039;S HOPE IT IS POSITIVE
	DCA	PCHI	/WELL.. JA IS POSITIVE
	SRAC		/GET &#039;ACL&#039; FROM SHR
	SRDN		/MOVE BACK &#039;ACH&#039;
	DCA	PC	/STORE ACL
	SRDN		/MOVE BACK &#039;ACX&#039;
	JMP I	(M8CHK	/CHECK AFTER JUMPS
/MISCELLANEOUS JUMP CLASS INSTRUCTIONS

FFJSA,	TAD	ADRLOW
	DCA	XRPNT	/USE XRPNT REG HERE
	TAD	ADRHI
	JMS I	(SETDF	//SET UP LOC TO SAVE PC IN
	AC0002		//
	TAD	ADRLOW	//
	DCA	ADRLOW	//BUMP ADDRESS BY 2
	SZL		//
	ISZ	ADRHI	//INC FOR 15 BIT
JSAR,	TAD	PCHI	//JSA/JSR COMMON CODE
	AND	C7	//
	TAD	(1030	//FORM &quot;JA&quot; INSTRUCTION
	DCA I	XRPNT	//
	ISZ	XRPNT	//
	SKP		//
	JMS I	(DFBUMP	//BUMP TARGET ADDRESS
	TAD	PC	//
	DCA I	XRPNT	//
	JMP	FFJA	//NOW JUMP TO DESTINATION

FFJSR,	AC0001
	TAD	BASADR
	DCA	XRPNT
	RAL
	TAD	BASHI
	JMS I	(SETDF	//SET DF&amp;T TO BASE PAGE LOC +1
	JMP	JSAR	//

	VALGT=SPA SNA CLA
	VALLE=SMA SZA CLA
	VALGE=SPA CLA
	VALLT=SMA CLA
	VALNE=SNA CLA
	VALEQ=SZA CLA
FFJGT,	TAD	(VALGT-VALLE
FFJLE,	TAD	(VALLE-VALGE
FFJGE,	TAD	(VALGE-VALLT
FFJLT,	TAD	(VALLT-VALNE
FFJNE,	TAD	(VALNE-VALEQ
FFJEQ,	TAD	(VALEQ
	DCA	CNDSKP
	JMS I	(SYNC	/WAIT FOR SIGN TO SET
	TAD	ACSGN	/EITHER -,0,+
CNDSKP,	HLT		/TEST AC
	JMP I	(FFNOP	/FAILED - DON&#039;T JUMP.
FFJA,	TAD	ADRLOW	//DF MAY BE RANDOM
	DCA	PC	//
	TAD	ADRHI	//
	DCA	PCHI	//
	JMP I	(M8CHK	//
FFSETX,	TAD	ADRHI	/SET XR0 LOC
	DCA	XRHI
	TAD	ADRLOW
	DCA	XRBASE
	JMP I	(FFNOP

FFSETB,	TAD	ADRHI	/SET BASE ADDRESS
	DCA	BASHI
	TAD	ADRLOW
	DCA	BASADR
	JMP I	(FFNOP

FETPC,	0		//GET NEW CODE ITEM
	TAD	PCHI	//DF MAY BE WRONG
	JMS I	(SETDF	//ANOTHER DF
	TAD I	PC	//
	CDF 10		/BE NICE TO ME
	ISZ	PC
	JMP I	FETPC
	ISZ	PCHI	/15 BIT INC
	JMP I	FETPC

FFADDX,	TAD I	XRPNT	//FIELD SET AT &#039;XROPR&#039;
FFLDX,	TAD	ADRLOW	//ADR SET AT &#039;SPECAL&#039;
	DCA I	XRPNT	//
	JMP I	(FFNOP	//

	PAGE
/ROUTINE TO NORMALIZE THE FAC

FFNOR,	0		//FFNOR DOES NOT TOUCH DF!
	TAD	ACSGN	//IS FAC ZERO?
	SNA CLA
	JMP I	FFNOR	//NO USE
	NRSR		//NORMALIZE SHR
	SKSR		//
	JMP	.-1	//DONE?
	SCAC		//GET STEP-COUNT
	CIA		//
	TAD	(377	//WAS IT MAX? (IE FAC=0)
	SNA		// (ALSO SUBTRACT 300 WHICH ARE ALWAYS SET)
	JMP	NORZER	//YES-INSURE ZERO EXPONENT
	TAD	(-77+1	//COMPENSATE FOR SIGN DISTANCE
	TAD	ACX	//AND ADJUST EXPONENT
	DCA	ACX	//
	TAD	(DOWN+1	//SHIFT DOWN 1 BIT
	ACSC		//DOWN AGAIN TO MANTISSA POSITION
	JMP I	FFNOR	//RETURN
NORZER,	DCA	ACSGN	//SET FAC=0
	CLSR		//WHY NOT ?
	JMP I	FFNOR	//

FIXSHF,	0		//USED FOR FIXING FAC IN SHR
	CIA		//MQ HOLDS LISH OR NO LISH
	TAD	ACX	//ACX-VALUE IS SHIFT COUNT
	SNA		//
	JMP I	FIXSHF	//ALREADY FIXED
	SMA		//IS IT SHIFT UP?
	JMP	FIXLIS	//YES
	CIA		//
	TAD	(DOWN	//NO : DOWN
FIXLIS,	DCA	FFNOR	//TEMP
	MQA		//WAS IT CIRCULAR ?
	SNA CLA
	 JMP	FSHIFT	//YES, DON&#039;T DESTROY FAC
	TAD	FFNOR	//
	AND	C3700	//IS SHIFT TOO BIG ?
	SNA CLA
	 JMP	FSHIFT	//NO, GO ON
	CLSR		//YES, NO HOPE
	DCA	ACSGN	//CLEAR FAC
	JMP I	FIXSHF	//AND EXIT
FSHIFT,	CLA MQA		//MQA MAY HOLD LISH
	TAD	FFNOR	//GET SHIFT COUNT AND DIRECTION
	ACSC		//SHIFT!
	SKSR		//
	JMP	.-1	//READY?
	JMP I	FIXSHF	//YES
FFXTA,	TAD	(27	//XR TO AC - NORMALIZE IF FLOATING MODE
	DCA	ACX	//XR DF
	TAD I	XRPNT	//
FFCLA,	CDF 10
	DCA	FFNOR	/TEMP SAVE
	JMS I	(SYNC	/WAIT FOR OP
	DCA I	(INIC	/OLD IC CONTENTS NOT INTERESTING
	CLSR		/CLEAR ALL IN CASE NO SYNC
	TAD	FFNOR	/
	DCA	ACSGN	/SIGN IS SAME AS VALUE
	TAD	ACSGN	/
	SPA		/IS VALUE NEGATIVE
	 CIA		/YES, MAKE POSITIVE
	ACSR		/SET ACL POSITIVE WITH SIGN IN ACSGN
	TAD	(14^2+DOWN
	ACSC		/MOVE TO POSITION
FFNORM,	TAD	DFLG	/
	SMA SZA CLA	/IS IT DP?
	 JMP I	(FFNOP	/YES, NO NORMALIZE
	JMS I	(UNLOAD	/NOOP FOR XTA AND FCLA
	JMS	FFNOR	/NO, NORMALIZE
	JMP I	(M8CHK	/

FFATX,	JMS I	(UNLOAD	//
	TAD	DFLG	//ATX WORKS DIFFERENTLY IN D.P.I. MODE
	SPA SNA CLA	//XR DF
	JMS	FFNOR	//DOES NOT TOUCH DF
	MQL		//CIRCULAR SHIFT!
	ACM1		//CALL SHIFT ROUTINE WITH WANTED EXP
	JMS	FIXSHF	//-1 IS REALLY 27(EXP)-14^2 &#039;ACL&#039; POS
	TAD	ACSGN	//GET SIGN OF FAC
	CLL RAL		//
	SRAC		//READ ACL
	SZL		//WAS FAC -?
	CIA		//YES, USE -FIXED QUANTITY
	DCA I	XRPNT	//STORE IN XR REG
	AC0001		//ROTATE FAC BACK
	TAD	ACX	//MQ STILL=0 FOR CIRCULAR
	TAD	ACX	//COMPENSATE -ACX IN &#039;FIXSHF&#039;
	JMS	FIXSHF	//ATX DOES NOT DESTROY FAC!
	JMP I	(M8CHK	//
FFALN,	JMS I	(UNLOAD	//
	TAD	ACSGN	//WAS FAC=0 ?
	SNA CLA		//
	 JMP I	(FFNOP	//YES, NOOP
	TAD	DFLG	//
	SMA SZA CLA	//
	DCA	ACX	//ZERO EXP IF D.I. MODE
	TAD	ADRHI	//
	AND	C7	//
	SZA CLA		//IF IT&#039;S AN &#039;ALN 0&#039;
	JMP	.+5	//
	TAD	DFLG	//AND IF WE&#039;RE IN FLOATING POINT MODE,
	SPA SNA CLA	//
	TAD	(27	//ALIGN UNTIL EXPONENT = 23
	SNA		//
	TAD I	XRPNT	//OTHERWISE ALIGN UNTIL EXPONENT = XR VALUE
	DCA	ZTEM1	//KEEP VALUE OF EXPONENT
	TAD	(LISH	//
	MQL		//INTO MQ FOR LINEAR SHIFT
	TAD	ZTEM1	//
	JMS	FIXSHF	//
	TAD	DFLG	//
	SMA SZA CLA	//IF DOUBLE INTEGER MODE,
	TAD	(27	//ALIGNMENT LEAVES THE EXPONENT UNCHANGED
	SNA		//
	TAD	ZTEM1	//IF FP,EP SET NEW EXPONENT
	DCA	ACX	//
	ACSR		//AND DELETE ANY RUBBISH IN EXP
	JMP I	(M8CHK	//

	PAGE
FFGET,	0		/GET OPERAND FROM CORE INTO SHR
	CDF 10		/FOR &#039;DCA I (INIC&#039;
	JMS I	(SYNC	/READ STATUS BEFORE NEW SHR FILL
	CLSR		/CLEAR BEFORE GET
	DCA I	(INIC	/OLD IC CONTENTS NOT USED
	AC7775		/
	TAD	DFLG	/
	DCA	ARCNT	/SET SIZE OF FAC 6,3 OR 2
	TAD	ADRHI	/SET DF OF TRANSFER
	JMS	SETDF	//
FFGELP,	TAD I	ADRLOW	//GET
	ACSR		//GET PUTS IN SHR
	SRUP		//NEXT IN SHR
	ISZ	ADRLOW	//
	SKP		//
	JMS I	(DFBUMP	//CLEARS LINK
	ISZ	ARCNT	//
	JMP	FFGELP	//
	TAD	DFLG	//
	SMA SZA CLA	//WAS IT DP?
	TAD	(27	//YES EXP=23
	SNA		//
	SRAC		//GET ACX FROM SHR IF NOT DP
	DCA	ACX	//IN CORE
	ACSR		//CLEAR FAC ACX
	SRUP		//POSITION ACH
	NOP		//DELAY
	SRAC		//GET ACH
	SRDN		//POSITION ACX AGAIN
	SPA SNA		//IF ACH POS, ALL POS
	JMS I	(MAKPOS	//MAKE POSITIVE IF NEGATIVE
	DCA	ACSGN	//AND SET SIGN
	JMP I	FFGET	//
FFPUT,	0		/PUT RESULT FROM SHR INTO CORE
	JMS I	(UNLOAD	/FIRST UNLOAD IC
	TAD	ACSGN	/IF FAC WAS NEGATIVE MAKE NEGATIVE
	SPA		/ONLY CALL FOR NEGATE
	JMS I	(MAKPOS	/CALLED WITH SIGN, RETURNS WITH SIGN
	CLA		/
	TAD	ACX	/TRANSFER ACX TO SHR
	ACSR		/
	AC7775		/
	TAD	DFLG	/
	DCA	ARCNT	/SET SIZE OF FAC 6,3 OR 2
	TAD	DFLG	/
	SMA SZA CLA	/
	SRUP		/DON&#039;T TRANSFER ACX FOR DP
	TAD	ADRHI	/SET DF OF TRANSFER
	JMS	SETDF	//
FFPLP,	SRAC		//PUT GETS FROM SHR
	DCA I	ADRLOW	//PUT
	SRUP		//NEXT IN SHR
	ISZ	ADRLOW	//
	SKP		//
	JMS I	(DFBUMP	//CLEARS LINK
	ISZ	ARCNT	//
	JMP	FFPLP	//
	TAD	ACSGN	/IF FAC WAS NEGATIVE MAKE NEGATIVE
	SPA		/ONLY CALL FOR NEGATE
	JMS I	(MAKPOS	/CALLED WITH SIGN, RETURNS WITH SIGN
	CLA
	ACSR		//CLEAR FAC ACX
	JMP I	FFPUT	//
FFDIV,	0
	AC0004		/FPIC SDIV
	JMS I	(FFCOMM
	JMP I	FFDIV

FFMPY,	0
	AC0003		/FPIC SMUL
	JMS I	(FFCOMM
	JMP I	FFMPY

FFSUB,	0
	AC0002		/FPIC SSUB
	JMS I	(FFCOMM
	JMP I	FFSUB

FFADD,	0
	AC0001		/FPIC SADD
	JMS I	(FFCOMM
	JMP I	FFADD	/RETURN

SETXR,	0		/AC HAS XR NUMBER
	CLL		/CLEAR FOR EVENTUAL OVERFLOW
	AND	C7	/
	TAD	XRBASE	/SET ADDRESS OF X0-X7
	DCA	XRPNT	/IN &#039;XRPNT&#039;
	RAL		/IF TO NEXT FIELD
	TAD	XRHI	/TO X0 FIELD
	JMS	SETDF	//
	JMP I	SETXR	//
SETDF,	0		//GET NEW FIELD FROM EMULATOR
	CDF 10		/FOR EMULATOR FIELD
	AND	C7	/32 K WRAP-AROUND
	DCA	FFVFLD	/VIRTUAL FIELD BITS IN USE
	TAD	FFVFLD
	TAD	FFPFLD	/ADDRESS OF RESIDENT FIELDS
	DCA	X
	TAD I	X	/IS FIELD ALLOCATED ?
	SZA
	 JMP	FFINFL	/YES, TAKE QUICK EXIT
	TAD	FFVFLD	/NO, MAKE INCORE REQUEST
	CLL RTL
	RAL
	JMS I	(EMGETF
FFINFL,	TAD	C6201
	DCA	FFRFLD
FFRFLD,	HLT		/REAL FIELD IN USE
	JMP I	SETDF

FFVFLD,	0
FFPFLD,	0		/POINTER TO UFLD TABLE

DFBUMP,	0		/BUMP TO NEXT FIELD
	TAD	FFVFLD
	IAC		/INC FIELD
	JMS	SETDF
	JMP I	DFBUMP

ARCNT,	0
	PAGE
/FPP AC-TO-MEMORY INTERPRETER
/
FFMPM,	0		/OP4 - FFMPY
	TAD	FFMPM
	DCA	FFADM	/SET RETURN ADDRESS
	TAD	(FFMPY-FFADD	/USE FFMPY FOR FFMPM (NATCH!)
	SKP
FFADM,	0		/OP1 - FFADD
	TAD	(FFADD
	DCA	ADMMPM	/
	TAD	ADRHI
	DCA	ADSAVF
	TAD	ADRLOW	
	DCA	ADSAV	/SAVE FOR DOUBLE OP
	JMS I	(UNLOAD	/WAIT FOR END
	JMS	APTDMP	/DUMP APT TO USER
	TAD	ADSAVF
	DCA	ADRHI
	TAD	ADSAV
	DCA	ADRLOW
	JMS I	ADMMPM	/GO TO MUL OR ADD
	TAD	ADSAV
	DCA	ADRLOW	/RESTORE ADR FOR PUT
	JMS I	(FFPUT	//PUT RESULT BACK IN LOC (WILL SET ADRHI FIELD)
	JMS	APTGET	/GET APT BACK (WITH OLD AC!)
	JMP I	FFADM
ADSAVF,	0
ADSAV,	0		/TEMPORARY ADRLOW
ADMMPM,	HLT		/EITHER FFMPY OR FFADD

FFNEG,	JMS I	(UNLOAD	/WE NEED THE SIGN FIRST
	TAD	ACSGN	/
	CIA		/
	DCA	ACSGN	/THAT WAS A QUICK ONE!
	JMP I	(FFNOP	/
APTDMP,	0
	JMS	APTSET	//
	JMS I	(FFPUT	//SETS APT FIELD
	TAD	DTEM	//
	DCA	DFLG	//
	TAD	APTL	//&#039;APT-1&#039;
	DCA	AUTO10
	TAD	BASHI	//IGNORE OPERAND FIELD
	AND	C7
	BSW
	MQL
	TAD	XRHI
	AND	C7
	CLL RTL
	RAL
	MQA
	MQL
	TAD	PCHI
	AND	C7
	MQA
	DCA I	AUTO10	//APT
	TAD	PC
	DCA I	AUTO10	//PC LOW
	TAD	XRBASE
	DCA I	AUTO10	//XR LOW
	TAD	BASADR
	DCA I	AUTO10	//BASE LOW
	CDF 10
	JMP I	APTDMP

APTGET,	0
	JMS	APTSET
	JMS I	(FFGET	//SETS APT FIELD
	TAD	DTEM	//
	DCA	DFLG	//
	TAD	APTL	//&#039;APT-1&#039;
	DCA	AUTO10
	TAD I	AUTO10	//APT
	DCA	PCHI
	TAD	PCHI
	CLL RTR
	RAR
	DCA	XRHI
	TAD	PCHI
	BSW
	DCA	BASHI
	TAD I	AUTO10	//PC LOW
	DCA	PC
	TAD I	AUTO10	//XR LOW
	DCA	XRBASE
	TAD I	AUTO10	//BASE LOW
	DCA	BASADR
	CDF 10
	JMP I	APTGET
APTSET,	0		//SET PARAMETERS FOR APT XFER
	CDF 10		/BE SURE
	TAD	DFLG	/SAVE DFLG
	DCA	DTEM
	TAD	DFLG
	SMA CLA
	DCA	DFLG	/NO DP MODE, FFPUT WOULD LOSE ACX
	JMS	GET
	   UAPTH
	DCA	ADRHI	/SET FIELD BITS FOR FFPUT
	ISZ	X	/GO TO APTLOW
	TAD I	X	/
	DCA	APTL	/SAVE &#039;APT-1&#039; A WHILE
	AC0006
	TAD	APTL
	DCA	ADRLOW	/SET &#039;ACX&#039; FOR FFPUT
	JMP I	APTSET	/

APTL,	0
DTEM,	0

CHKM8,	0		//CHECK ON MULTI-8 REQUESTS
	CDF 0		//
	TAD I	(IHEAD	//TASK IN INTQ ?
	SNA		//
	TAD I	(MHEAD	//TASK IN MAINQ ?
	CDF 10		/
	SNA CLA		/
	 JMP I	CHKM8	/NO, GO ON (DF=10)
	JMS	MONITOR	/
	   PRECEDE	/GIVE OTHERS A CHANCE
	JMS	SETBASE	/RESTORE BASE
	JMP I	CHKM8	/
	PAGE
	O=JMP	NPNONG
MAKPOS,	0		//NEGATE SHR IF NECCESARY
	SMA CLA		//IF CALLED WITH -SIGN
	TAD	(O-7000 //IF POSITIVE ONLY CHECK FOR 0 FAC
	TAD	C7000	//IF NEGATIVE DO ALL
	DCA	NPSW	//PLACE INSTRUCTION IN LOOP
	DCA	ZTEM1	//SET FAC=0 SWITCH TO 0
	SRDN		//ACL OR EAC3 IN PLACE
	TAD	DFLG	//
	SMA		//SKIP IF EP
	CLA		//IGNORE DP
NPFPDP,	TAD	M2	//-2 = -2 FOR FP,DP -5 FOR EP
	DCA	ZTEM2	//FOR WORD COUNT
	STL		//SET LINK FOR FIRST NEGATE
NPLU,	SRAC		//GET LS ETC
	SZA		//WAS THIS BYTE = 0 ?
	ISZ	ZTEM1	//NO : FAC IS NON-ZERO
NPSW,	NOP		//OR JMP NPNONG IF ONLY ZERO CHECK
	CMA
	SZL		//BORROW OR START?
	CLL IAC		//YES MAKE &#039;CIA&#039;
NPNONG,	ACSR		//BACK TO SHR
	SRDN		//NEXT 12 BITS
	ISZ	ZTEM2	//DONE?
	JMP	NPLU
	ACSR		//CLEAR EXP AGAIN
	TAD	ZTEM1	//GET # FROM 0 TO 5
	SZA CLA		//IF ZERO, FAC IS ZERO
	TAD	NPSW	//IF NON-ZERO LOAD 7000 OR 5XXX
	CLL RAL		//LEAVES 6000, 0, 2XXX IN AC
	JMP I	MAKPOS	//LEAVE WITH ACX IN POSITION
			//RETURN WITH SIGN IN AC
FFLOAD,	0
	JMS I	(FFNOR	//BE SURE FAC IS NORMALIZED
	TAD	(2+LISH
	ACSC		//POSITION MANTISSA LEFT
	TAD	DFLG	//EP OR FP?
	SPA CLA
	 JMP	FFLOEP	//GO TO EP PART
FFLOFP,	TAD	FF176	//GET EXP OFFSET
	TAD	ACX	//
	AND	FF377	//MASK WITH MAX BITS FOR EXP
	MQL		//NEW IC EXPONENT
	TAD	ACSGN	//OUR SIGN
	SNA		//WAS IT ZERO?
	MQL		//ZERO SIGN IS ZERO VALUE
	CLL RAL		//PICK OUT SIGN BIT
	CLA RTR
	RTR		//PUT SIGN AGAINST EXP
	MQA		//GET EXP
	ACSR		//LOAD IT IN HOLE
	TAD	(DOWN+11+4	//GET FINAL SHIFT
FFLOEN,	ACSC
FF377,	377		//DELAY
	SRFP		//LOAD IC
	SKSR
	JMP	.-1
	JMP I	FFLOAD	//RETURN

FFLOEP,	TAD	(1776	//GET EXP OFFSET
	TAD	ACX	//
	CLL RAL		//MASK WITH MAX BITS FOR EXP
	MQL		//NEW IC EXPONENT
	TAD	ACSGN	//OUR SIGN
	SNA		//WAS IT ZERO?
	MQL		//ZERO SIGN IS ZERO VALUE
	CLL RAL		//PICK OUT SIGN BIT
	CLA MQA		//GET EXP
	RAR		//PUT BACK SIGN,EXP IN 4,3777
	ACSR		//LOAD IT IN HOLE
	TAD	(DOWN+14+10	//GET FINAL SHIFT
	JMP	FFLOEN	//
FFSTRE,	TAD	DFLG	//WAS IT ALREADY EP?
	SPA CLA		//
	 JMP I	(FFNOP	//YES, IT&#039;S A NOP.
	JMS I	(UNLOAD	//NO, SORRY
	AC2000		//XR DF
	SEMO		//SET MODE FOR EAC CLEAR
	TAD	(14^3+LISH	//CLEAR EXTENDED FAC
	ACSC		//
	ACM3		//SET DFLG=-3 FOR EP
	DCA	DFLG	//
	AC0004
	JMP 	SESTAT	//
FFSTRD,	TAD	DFLG	//
	SMA SZA CLA	//WAS IT ALREADY DP ?
	 JMP I	(FFNOP	//YES, NOOP
	JMS I	(UNLOAD	//NO, SORRY
	TAD	(27	//
	DCA	ACX	//IT&#039;S AN INTEGER!
	AC0001		//
	JMP	SEDPFP	//
FFSTRF,	TAD	DFLG	//WAS IT ALREADY FP ?
	SNA CLA		//
	 JMP I	(FFNOP	//YES, NOOP
	JMS I	(UNLOAD	//NO, SORRY
SEDPFP,	MQL		//SAVE
	TAD	DFLG	//
	SMA CLA		//WAS IT EP ?
	 JMP	NOEP	//NO
	TAD	(14^3+DOWN+LISH
	ACSC		//MOVE ACH,ACL DOWN
FF176,	176		//DELAY
NOEP,	MQA
	DCA	DFLG	//
	ACSR		//CLEAR EXP
	SEMO		//SET SHR SIZE
	TAD	DFLG	//
	CLL RTR		//MAKE AC4000 IF DP
SESTAT,	MQL		//
	CDF 10		/STATUS IN THIS FIELD
	JMS	GET	/
	   UFPST
	AND	(3773	/CLEAR OLD DP,EP BITS
	MQA		/
	DCA I	X	/SET NEW DP OR EP BIT
	JMP I	(M8CHK	/
	PAGE
			/END IFDEF FPP &gt;
</pre>
<hr/>
</div>