FIXMRI FADD=1000
FIXMRI FSUB=2000
FIXMRI FMPY=3000
FIXMRI FDIV=4000
FIXMRI FGET=5000
FIXMRI FPUT=6000
FNOR=7000
FEXT=0000
FIXTAB
/23-BIT EXTENDED FUNCTIONS

/1-31-72       R BEAN

/COPYRIGHT     1972 DIGITAL EQUIPMENT CORPORATION,MAYNARD, MASS. 01754

/DEC-08-NFPPA-A	VERSION 1

	EXP=44
	HORD=45
	LORD=46

FIXFLT=5500
	*FIXFLT

	/******FIX******
/ROUTINE TO FIX ANY FLOATING NUMBER IN FAC BETWEEN -2047 AND +2047 TO
/A TWELVE BIT INTEGER AND LEAVE RESULT IN EXP (LOC 44)

FFIX,	0
	CLA
	TAD EXP		/FETCH EXPONENT
	SZA SMA		/IS NUMBER <1?
	 JMP .+3	/NO-CONTINUE ON
FTRPRT,	CLA
	JMP FIXDNE+1	/YES-FIX IT TO ZERO
	TAD M13		/SET BINARY POINT AT 11
	SNA		/PLACES TO RIGHT OF CURRENT POINT?
	 JMP FIXDNE	/NO-NUMBER IS ALREADY FIXED THEN.
	SMA		/YES-IS NUMBER TOO LARGE TO FIX?
	 JMP I OTRAPA	/YES-TAKE OVERFLOW TRAP
	DCA EXP		/NO-SET SCALE COUNT
FIXLP,	CLL		/0 IN LINK
	TAD HORD	/GET HIGH MANTISSA
	SPA		/IS IT <0?
	 CML		/YES-PUT A 1 IN LINK
	RAR		/SCALE RIGHT
	DCA HORD	/SAVE
	ISZ EXP		/DONE YET?
	 JMP FIXLP	/NO
FIXDNE,	TAD HORD	/YES-ANSWER IN AC
	DCA EXP		/RETURN WITH ANSWER IN 44
	JMP I FFIX	/RETURN

M13,	-13		/-11 DECIMAL
C13,	13		/11 DECIMAL
OTRAPA,	FTRP1		/ADDRESS OF VECTOR FOR OVERFLOW TRAP

/******FLOAT******
/ROUTINE TO FLOAT ANY INTEGER IN EXP (LOC 44) INTO FAC

FFLOAT,	0
	TAD EXP
	DCA HORD	/PUT NUMBER IN HI MANTISSA
	DCA LORD	/CLEAR LOW MANTISSA
	TAD C13		/11(10) INTO EXPONENT
	DCA EXP
	JMS I FNORL	/NORMALIZE
	JMP I FFLOAT	/RETURN
FNORL,	FFNOR		/LINK TO NORMALIZE ROUTINE
*5000

/******SINE******

SIN,	0
	JMS NHNDLE	/IF X<0,NEGATE X AND SET NFLAG
	JMS I FMPYL	/X*2/PI
	  TOVPI
	JMS FRACT	/SAVE X IN TEMP1,THE INTEGER PART OF X IN NUM,AND GET FRACTIONAL PART IN FAC
	TAD NUM		/GET INTEGER PART OF (2/PI)*X
	AND C3		/ISOLATE BITS 10,11
	TAD JMPI
	DCA .+1		/MAKE JUMP TO ARGUMENT REDUCING ROUTINE
	JMP .		/AND ADJUST ARG ACCORDING TO QUADRANT OF X
JMPI,	JMP I .+1
	POLYSN		/X IN QUAD1,SIN(X)=SIN(X)
	QUAD2		/X IN QUAD2,SIN(X)=SIN(1-X)
	QUAD3		/X IN QUAD3,SIN(X)=SIN(-X)
	QUAD4		/X IN QUAD4,SIN(X)=SIN(X-1)

QUAD2,	JMS I FSUB1L	/1-X
	  ONE
	JMP POLYSN	/CALCULATE SIN(1-X)
QUAD3,	JMS I FNEGL	/-X
	JMP POLYSN	/CALCULATE SIN(-X)
QUAD4,	JMS I FSUBL	/X-1
	  ONE
POLYSN,	JMS I FPUTL	/SAVE X
	  TEMP1
	JMS I FSQRL	/U=X**2
	JMS I FPUTL	/SAVE U
	  TEMP2
	JMS I FMPYL	/A7*U
	  SINA7
	JMS I FADDL	/A5+A7*U
	  SINA5
	JMS I FMPYL	/A5*U+A7*U**2
	  TEMP2
	JMS I FADDL	/A3+A5(U)+A7(U**2)
	  SINA3
	JMS I FMPYL	/A3(U)+A5(U**2)+A7(U**3)
	  TEMP2
	JMS I FADDL	/A1+A3(U)+A5(U**2)+A7(U**3)
	  SINA1
	JMS I FMPYL	/A1(X)+A3(X**3)+A5(X**5)+A7(X**7)
	  TEMP1
	JMS NCHK	/IF NFLAG IS SET,SET SIN(X)=-SIN(X)
	JMP I SIN	/FAC=SIN(X)


/******COSINE******
/USES SIN ROUTINE TO CALCULATE COS(X)

COS,	0
	JMS I FADDL	/COS(X)=SIN(PI/2+X)
	  PIOV2
	JMS SIN
	JMP I COS	/RETURN

FGETL,	FFGET
FADDL,	FFADD
FMPYL,	FFMPY
FPUTL,	FFPUT
FDIVL,	FFDIV
FSUB1L,	FFSUB1
FNEGL,	FFNEG
FSUBL,	FFSUB
FSQRL,	FFSQ
FIXL,	FFIX
FLOATL,	FFLOAT
FDIV1L,	FFDIV1
C3,	3
TEMP1,	0
	0
	0
TEMP2,	0		/TWO TEMP STORAGE BLOCKS FOR FUNCTIONS
	0
	0
ONE,	1		/1
	2000
	0

/ROUTINE TO SEPERATE THE INTEGER AND FRACTIONAL PARTS OF FAC
/ORIGINAL FAC IS SAVED IN TEMP1,THE INTEGER PORTION OF FAC IS
/SAVED AT NUM,AND THE FRACTIONAL FORTION OF THE FAC IS LEFT IN THE FAC

FRACT,	0
	JMS I FPUTL	/SAVE X
	  TEMP1
	JMS I FIXL	/INTEGER PORTION OF X
	TAD EXP
	DCA NUM		/SAVE FIXED FORTION OF X
	JMS I FLOATL	/FAC=FLOAT(FIX(X))
	JMS I FSUB1L	/FAC=X-INT(X)=FRACTION (X)
	  TEMP1
	JMP I FRACT	/RETURN

/ROUTINE TO CHECK IF FAC<0; IF IT IS,FAC IS NEGATED AND NFLAG IS
/SET TO 1

NHNDLE,	0
	TAD HORD	/FETCH HIGH ORDER MANTISSA
	SMA CLA		/IS IT <0?
	 JMP NFLGST	/NO-CLEAR NFLAG
	JMS I FNEGL	/YES-NEGATE FAC
	IAC		/AND SET NFLAG
NFLGST,	DCA NFLAG
	JMP I NHNDLE

/ROUTINE TO NEGATE FAC IF NFLAG IS NOT =0

NCHK,	0		/LOC ALSO USED FOR TEMP STORAGE
	TAD NFLAG
	SZA CLA		/IS NFLAG=0?
	 JMS I FNEGL	/NO-NEGATE FAC
	JMP I NCHK	/YES-RETURN

	NUM=NCHK

/******EXPONENTIAL******

EXPON,	0		/LOC USED FOR TEMP STORAGE BY SIN,ARCTAN
	JMS I FMPYL	/Y=XLOG2(E)
	  LOG2E
	JMS FRACT	/GET FRACTIONAL PART OF Y
	JMS I FMPYL	/(FRACTION(Y))*(LN2/2)
	  LN2OV2
	JMS I FPUTL	/SAVE Y
	  TEMP1
	JMS I FSQRL	/Y**2
	JMS I FADDL	/B1+Y**2
	  EXPB1
	JMS I FDIV1L	/A1/(B1+Y**2)
	  EXPA1
	JMS I FADDL	/A0+A1/(B1+Y**2)
	  EXPA0
	JMS I FSUBL	/A0-Y+A1/(B1+Y**2)
	  TEMP1
	JMS I FPUTL	/SAVE
	  TEMP2
	JMS I FGETL	/GET Y
	  TEMP1
	ISZ EXP		/MULT. BY 2=2Y
	 NOP
	JMS I FDIVL	/2Y/(A0-Y+A1/(B1+Y**2))
	  TEMP2
	JMS I FADDL	/1+2Y/(AO-Y+A1/(B1+Y**2))
	  ONE
	JMS I FSQRL	/[1+2Y/(A0-Y+A1/(B1+Y**2))]**2=EXP(Y)
	TAD NUM
	TAD EXP		/EXP(X)=(2**N)(EXPY)
	DCA EXP
	JMP I EXPON	/FAC=EXPON(X)

	NFLAG=EXPON

/CONSTANT THAT WOULDN'T FIT ELSEWHERE
TOVPI,	0		/.6366198
	2427
	6302
	*SIN+200

/******ARC TANGENT******

ATAN,	0
	JMS I NHNDLL	/IF X<0,SET NFLAG AND NEGATE
	JMS I FPUTM	/SAVE X
	  TEMP1
	JMS I FSUBM	/X-1
	  ONE
	TAD HORD	/GET HI MANTISSA
	SPA CLA		/WAS X>1?
	 JMP ARGPOL	/NO-CLEAR GT1FLG
	JMS I FGETM	/YES-ATAN(X)=PI/2-ATAN(1/X)
	  ONE
	JMS I FDIVM	/1/X
	  TEMP1
	JMS I FPUTM
	  TEMP1
	IAC		/SET GT1FLG
ARGPOL,	DCA GT1FLG
	JMS I FGETM	/GET X OR 1/X
	  TEMP1
	JMS I FSQRM	/Y**2
	JMS I FPUTM	/SAVE
	  TEMP2
	JMS I FADDM	/Y**2+B3
	  ATANB3
	JMS I FDIV1M	/A3/(Y**2+B3)
	  ATANA3
	JMS I FADDM	/B2+A3/(Y**2+B3)
	  ATANB2
	JMS I FADDM	/Y**2+B2+A3/(Y**2+B3)
	  TEMP2
	JMS I FDIV1M	/A2/(Y**2+B2+A3/(Y**2+B3))
	  ATANA2
	JMS I FADDM	/B1+A2/(Y**2+B2+A3/(Y**2+B3))
	  ATANB1
	JMS I FADDM	/Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3))
	  TEMP2
	JMS I FDIV1M	/A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3)))
	  ATANA1
	JMS I FADDM	/B0+A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3)))
	  ATANB0
	JMS I FMPYM	/ATAN(Y)=X*(B0+A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3))))
	  TEMP1
	TAD GT1FLG	/WAS X>1?
	SNA CLA
	 JMP NGT	/NO-TEST IF X<0?
	JMS I FSUB1M	/ATAN(X)=PI/2-ATAN(1/X)
	  PIOV2
NGT,	JMS I NCHKL	/IF NFLAG SET,NEGATE FAC
	JMP I ATAN	/FAC=ATAN(X)
NHNDLL,	NHNDLE
NCHKL,	NCHK

/******NAPERIAN LOGARITHM******

	GTFLG=ATAN

LOG,	0
	TAD HORD
	SPA SNA		/X<0 OR X=0?
	 JMP I ARTRAP	/YES-TAKE ILLEGAL ARGUMENT TRAP
	CLL RTL
	SNA		/NO-HORD=2000?
	 TAD EXP	/YES-EXP=1?
	CMA IAC
	IAC
	SNA
	TAD LORD	/YES-LORD=0?
	SZA CLA
	 JMP POLYNL	/NO-ARG IS LEGAL AND NOT 1
	DCA EXP
	DCA LORD
LTRPRT,	DCA HORD
	JMP I LOG	/YES-LOG(1)=0
POLYNL,	TAD EXP
	DCA GTFLG	/SAVE EXPONENT FOR LATER
	DCA EXP		/ISOLATE MANTISSA IN FAC
	JMS I FPUTM	/SAVE F
	  TEMP1
	JMS I FADDM	/F+SQR(.5)
	  SQRP5
	JMS I FPUTM	/SAVE
	  TEMP2
	JMS I FGETM
	  TEMP1
	JMS I FSUBM	/F-SQR(.5)
	  SQRP5
	JMS I FDIVM	/Z=F+SQR(.5)/F-SQR(.5)
	  TEMP2
	JMS I FPUTM
	  TEMP1
	JMS I FSQRM	/Z**2
	JMS I FPUTM
	  TEMP2
	JMS I FMPYM	/C5(Z**2)
	  LOGC5
	JMS I FADDM	/C3+C5(Z**2)
	  LOGC3
	JMS I FMPYM	/C3(Z**2)+C5(Z**4)
	  TEMP2
	JMS I FADDM	/C1+C3(Z**2)+C5(Z**4)
	  LOGC1
	JMS I FMPYM	/C1(Z)+C3(Z**3)+C5(Z**5)
	  TEMP1
	JMS I FSUBM	/C1(Z)+C3(Z**3)+C5(Z**5)-1/2=LOG2(F)
	  ONEHAF
	JMS I FPUTM	/SAVE LOG2(F)
	  TEMP2
	TAD GTFLG	/I
	DCA EXP		/SET UP FLOAT
	JMS I FLOATM
	JMS I FADDM	/I+LOG2(F)
	  TEMP2
	JMS I FMPYM	/[I+LOG2(F)]*LOGE(2)=LOGE(X)
	  LN2
	JMP I LOG	/FAC=LN(X)

	GT1FLG=LOG
FPUTM,	FFPUT
FMPYM,	FFMPY
FADDM,	FFADD
FDIVM,	FFDIV
FDIV1M,	FFDIV1
FSUBM,	FFSUB
FSUB1M,	FFSUB1
FSQRM,	FFSQ
FLOATM,	FFLOAT
FGETM,	FFGET
ARTRAP,	FTRP3

/CONSTANTS USED BY VARIOUS FUNCTIONS

SINA1,	1		/1.5707949
	3110
	3747
SINA3,	0		/-.64592098
	5325
	1167
SINA5,	7775		/.07948766
	2426
	2466
SINA7,	7771		/-.004362476
	5610
	3164
PIOV2,	1		/1.5707963
	3110
	3756
LOG2E,	1		/1.442695
	2705
	2434
LN2OV2,	7777		/.34657359
	2613
	4415
EXPB1,	6		/60.090191
	3602
	7054
EXPA1,	12		/-601.80427
	5514
	3104
EXPA0,	4		/12.015017
	3001
	7301
ATANB0,	7776		/.17465544
	2626
	6157
ATANA1,	2		/3.7092563
	3553
	1071
ATANB1,	3		/6.762139
	3303
	670
ATANA2,	3		/-7.10676
	4344
	5267
ATANB2,	2		/3.3163354
	3241
	7554
ATANA3,	7777		/-.26476862
	5703
	4040
ATANB3,	1		/1.44863154
	2713
	3140
SQRP5,	0		/.7071068
	2650
	1170
LOGC1,	2		/2.8853913
	2705
	2440
LOGC3,	0		/.9614706
	3661
	566
LOGC5,	0		/.59897865
	2312
	5525
ONEHAF,	0		/.5
	2000
	0
LN2,	0		/.6931472
	2613
	4415

	FFSIN=SIN
	FFCOS=COS
	FFATN=ATAN
	FFLOG=LOG
	FFEXP=EXPON


	PAUSE

/23-BIT FLOATING PT INTERPRETER
/DEC-08-NFPPA-A	VERSION 1
/COPYRIGHT	 1972 BY DIGITAL EQUIPMENT CORPORATION
/MAYNARD, MASSACHUSETTS. 01754
/
/W.J. CLOGHER
/
/
/DEFINITION FOR ORIGIN OF PACKAGE
/
FLPT=7400

/
/PAGE ZERO LOCATIONS USED 
/
*7
FPP,	FPT	/IF THIS IS MOVED, FIX LOC. K7
*40
AC0,	0
AC1,	0
AC2,	0
TM,	CDF 0	/ONLY NEEDED ONCE (FIRST CALL TO CDFCUR)
ACX,	0	/FLOATING ACCUMULATOR-EXPONENT
ACH,	0	/   "          "     -HIGH ORDER MANTISSA
ACLO,	0	/   "          "     -LOW ORDER MANTISSA
OPX,	0	/STORAGE FOR OPERAND
OPH,	0
OPL,	0
DSWIT,	0	/SWITCH SHOWING IF ANY INPUT CONV. WAS DONE
CHAR,	0	/LOCATION HOLDING TERMINATOR OF LAST INPUT.
SWIT1,	7777	/=0 IF NO LINE FEED AFTER CAR.RET. ON INPUT
SWIT2,	7777	/=0 IF NO CR/LF AFTER OUTPUT
/
/IF EFLG = 0, 6 IS DEPOSITED INTO DADP, AND 16 (8) INTO FLDW
/
EFLG,	0	/=0 IF E FORMAT OUT
FLDW,	0	/FIELD WIDTH ON OUTPUT
DADP,	0	/=# OF PLACES AFTER DEC. PT.
FPNXT,	FPNEXT	/(DON'T USE FPNEXT AS A TEM!! E.G. IN I/O
		/SINCE OS/8 BASIC MAY BE THERE INSTEAD!!!)

*FLPT-2600
/
/PARTS OF INTERPRETER DISPATCH ROUTINES
/
/TABLE FOR JUMPS-OP CODE 7
/
JMPI3,	JMP I	TABLE3
TABLE3,	FFSKP		/SKIP ON CONDITION OF FAC
	FFCDF		/CHANGE FLTG. DATA FIELD
	FFSW0		/FLOATING SWITCH 0
	FFSW1		/FLOATING SWITCH 1
	FFHLT		/FLOATING HALT-DISPLAY PC
	FPNEXT		/NOP-FOR FUTURE EXPANSION
	FPNEXT		/ "
	FPNEXT		/ "
/
/ROUTINE FOR DECODING SPECIAL FJMS'S-OP CODE 7
/
JSKP,	TAD	OPH	/GET EFF. ADDR.
	AND	P7	/MASK OFF BITS 9-11
	TAD	JMPI3	/MAKE A JUMP THROUGH TABLE
	DCA	.+1	/STORE IT
	0		/EXECUTE IT
P7,	7
/
/FLOATING SWITCH 1
/
FFSW1,	JMS I	CDFCRK	/MUST BE CURRENT DATA FIELD
	TAD	FFSB1	/CHANGE INTERPRETATION OF SUB, DIV
	DCA I	TSUBP	/SO THAT FAC IS SUBTRACTED
	TAD	FFDV1	/FROM OR DIVIDED INTO OPERAND
	DCA I	TDIVP
	JMP I	FPNXT	/DONE
FFSB1,	FFSUB1
FFDV1,	FFDIV1
TSUBP,	TSUB
TDIVP,	TDIV

*FLPT-2500
/
/THIS STUFF MUST BE HERE CAUSE OS/8 BASIC EXPECTS IT  
/TO BE HERE
/
/MDSET-SETS UP SIGNS FOR MULTIPLY AND DIVIDE
/ALSO SHIFTS OPERAND ONE BIT TO THE LEFT.
/EXIT WITH EXPONENT OF OPERAND IN AC FOR EXPONENT
/CALCULATION-CALLED WITH ADDRESS OF OPERAND IN AC AND
/DATA FIELD SET PROPERLY FOR OPERAND.
/
MDSET,	0
	JMS I	ARGETK	/GET ARGUMENT
MD1,	JMS I	CDFCRK	/CHANGE TO DF OF PACKAGE
	CLA CLL CMA RAL	/SET SIGN CHECK TO -2
	DCA	TM
	TAD	OPH	/IS OPERAND NEGATIVE?
	SMA	CLA
	JMP	.+3	/NO
	JMS I	OPNEGP	/YES-NEGATE IT
	ISZ	TM	/BUMP SIGN CHECK
	TAD	OPL	/AND SHIFT OPERAND LEFT ONE BIT
	CLL	RAL
	DCA	OPL
	TAD	OPH
	RAL
	DCA	OPH
	DCA	AC1	/CLR. OVERFLOW WORF OF FAC
	TAD	ACH	/IS FAC NEGATIVE
	SMA	CLA
	JMP	LEV	/NO-GO ON
	JMS I	FFNEGK	/YES-NEGATE IT
	ISZ	TM	/BUMP SIGN CHECK
	NOP		/MAY SKIP
LEV,	TAD	OPX	/EXIT WITH OPERAND EXPONENT IN AC
	JMP I	MDSET

FFNEGK,	FFNEG
OPNEGP,	OPNEG
CDFCRK,	CDFCUR
ARGETK,	ARGET
/
/CONTINUATION OF FLOATING DIVIDE ROUTINE
/
FD1,	TAD	AC2	/NEGATE HI ORDER PRODUCT
	CLL CMA IAC
	TAD	ACH	/COMPARE WITH REMAINDER OF FIRST DIV.
	SNL		/WELL?
	JMP I	DVOPSP	/GREATER THAN REM.-ADJUST QUOT OF 1ST DIV.
	CLL		/OK-DO  (REM-(Q*OPL))/OPH
	DCA	ACH	/FIRST STORE ADJUSTED PRODUCT
	JMS I	DV24P	/DIVIDE BY OPH (HI ORDER OPERAND)
DVL1,	TAD	AC1	/GET QUOT. OF FIRST DIV.
	SMA		/IF HI ORDER BIT SET-MUST SHIFT 1 RIGHT
	JMP	FD	/NO-ITS NORMALIZED-DONE
	CLL	RAR	/MUST SHIFT RIGHT 1
	DCA	ACH	/STORE IN FAC
	TAD	ACLO	/SHIFT LOW ORDER RIGHT
	RAR
	DCA	ACLO	/STORE BACK
	ISZ	ACX	/BUMP EXPONENT
	NOP
	TAD	ACH
FD,	DCA	ACH	/STORE HIGH ORDER RESULT
	JMP I	FDDONP	/GO LEAVE DIVIDE

FDDONP,	FDDON		/END OF FLTG. DIV. ROUTINE
DV24P,	DV24		/ROUTINE TO DO A 24X12BIT DIVIDE
DVOPSP,	DVOPS		/ROUTINE TO ADJUST QUOT OF FIRST DIV.
/
/CONTINUATION OF ROUTINE TO ADJUST QUOT. OF FIRST DIV.
/DBAD1 IS ONLY EXECUTED ON DIVIDE OVERFLOW-OTHERWISE THE
/ROUTINE STARTS AT DVOP2
/
DBAD1,	DCA	ACX	/DIVIDE OVERFLO-ZERO ALL
DVOP2,	SNA		/IS IT ZERO?
	DCA	ACLO	/YES-MAKE WHOLE THING ZERO
	DCA	ACH
	JMS I	DV24P	/DIVIDE EXTENDED REM. BY HI DIVISOR
	TAD	ACLO	/NEGATE THE RESULT
	CLL CMA IAC
	DCA	ACLO
	SNL		/IF QUOT. IS NON-ZERO, SUBTRACT
	CMA		/ONE FROM HIGH ORDER QUOT.
	JMP	DVL1	/GO TO IT
*FLPT-1600

/
/FLOATING OUTPUT ROUTINE
/
FFOUT,	0
	CLA CLL CMA RAL	/MAKE A MINUS TWO
	DCA I	FFNGP	/AND STORE IN SIGN WORD
	DCA	KNT	/CLEAR COUNT WORD
	TAD	EFLG	/IS THIS E FORMAT?
	SZA	CLA	
	JMP	FFMT	/NO-F FORMAT
	TAD	K6	/YES-GET A 6
	DCA	DADP	/STORE AS # OF DIGITS AFT DEC PT
	TAD	K16	/SET FIELD WIDTH TO 14 ( DECIMAL)
	DCA	FLDW
FFMT,	JMS I	CDFCRB	/CHANGE TO FIELD OF PACKAGE
	TAD	KM7	/SET # OF SIGNF. DIGITS
	DCA I	DCNTP	/TO 6 (DON'T PRINT 7TH)
	TAD	ACH	/DETERMINE IF #=0
	SNA
	JMP	FOUT3	/YES-SKIP DOWN
	SMA	CLA	/NO-IS IT NEGATIVE?
	JMP	.+3	/POSITIVE
	JMS I	FFNGP	/NEGATE #
	DCA I	FFNGP	/NEGATIVE-SET FLAG
FOUT1,	TAD	ACX	/GET # INTO RANGE .1<=N<1
	SMA SZA CLA	/IS EXP. NEG.?
	JMP	FOUT2	/NO-GO ON
	JMS I	FFMPP	/YES-MAKE # GREATER THAN 1
	TEN		/BY MULTIPLYING BY TEN (DEC.)
	ISZ	KNT	/COUNT THE MULTIPLIES
	JMP	FOUT1	/SEE IF >1 YET
FOUT2,	JMS	SE	/# IS >1-MAKE IT LESS THAN 1
	JMS I	FFPUTP	/STORE IN A TEMPORARY
	TM3
	DCA	ACX	/SET FAC TO .5
	CLL CML RTR
	DCA	ACH
	DCA	ACLO
	TAD	EFLG	/IS THIS E FORMAT?
	SZA	CLA
	TAD	KNT	/NO-GET COUNT OF MULTIPLIES
	CMA	IAC	/NEGATE IT
	TAD	DADP	/AND ADD # OF DIGITS AFT. DC. PT.
	SMA		/MUST BE NEGATIVE
	CMA
	TAD	KK7	/LIMIT # OF DIVS TO 7
	SPA
	CLA
	TAD	KM7	/RESTORE
	DCA	SE	/STORE AS COUNTER
	JMP	.+3
	JMS I	FFDVP	/DIVIDE .5 BY TEN THAT # OF TIMES
	TEN
	ISZ	SE	/DONE?
	JMP	.-3	/NO-GO ON
	JMS I	FFADP	/YES-ADD IN ORIG.#-THIS IS ROUNDING
	TM3
	JMS	SE	/INSURE THAT IT IS IN RANGE
FOUT4,	TAD	ACX	/SHIFT MANTISSA ACCORDING TO EXP
	CMA	IAC	/0=1 LEFT; 1=NO SHIFT;2=1 RIGHT,...
	JMS I	ACSRPT	/SHIFT RIGHT (ACX+1) PLACES
	JMS I	AL1PT	/SHIFT LEFT 2 TO CORRECT
	JMS I	AL1PT	/(WE ARE LOSING BITS!!)
FOUT3,	TAD	KNT	/DONE-GET COUNT OF MULS.
	DCA	OPX	/PRESERVE IT
	TAD	EFLG	/IS THIS E FORMAT OUT?
	SZA	CLA
	JMP	NOTE	/NO
	DCA	KNT	/YES-ZERO COUNT
	TAD	KM7	/GET MINUS 7-FOR 2 SIGNS,PT,+EXP
	JMP	ADFW	/GO ADD FIELD WIDTH
ACSRPT,	ACSR
AL1PT,	AL1
/
/ROUTINE TO GET FAC<1
/
SE,	0
SE1,	TAD	ACX
	SPA SNA CLA	/#>1?
	JMP I	SE	/NO-RETN.
	JMS I	FFDVP	/YES-DIV. BY TEN
	TEN
	CMA
	TAD	KNT	/REDUCE KNT BY 1
	DCA	KNT
	JMP	SE1
/CONSTANTS AND POINTERS
OUTDGP,	OUTDG
K16,	16
CDFCRB,	CDFCUR
FLINK,	JMP I	FFOUT
PRNTXP,	PRNTX
PRZROP,	PRZRO
DGTYPP,	DGTYP
DCNTP,	DCNT
M1,	7777
KK7,	7
KM20,	-20
KM7,	-7
FFADP,	FFADD
FFDVP,	FFDIV
FFPUTP,	FFPUT
FFMPP,	FFMPY
FFNGP,	FFNEG
KNT,	0
K6,	6
/CONTINUATION OF OUTPUT MAINLINE
NOTE,	TAD	KNT	/GET COUNT OF MULTIPLIES
	SMA		/IF NOT NEG-MAKE = -2
	CLA	CMA
	TAD	M1	/MINUS 1 FOR DEC.PT
ADFW,	TAD	FLDW	/GET THE FIELD WIDTH
	CMA	IAC	/NEGATE IT
	DCA I	FFDVP	/STORE WHILE WE CHECK DADP
	TAD	DADP	/GET DIGITS AFTER DEC. PT
	SNA		/DID HE SAY NO DEC. PLACES?
	CMA		/YES-TAKE AWAY 1 SINCE NO DEC. PT.
	TAD I	FFDVP	/ADD IN REST
	SMA		/NEG?
	JMP I	PRNTXP	/NO-PRINT XS-NOT ENUFF ROOM
	DCA	SE	/STORE AS CNT OF SPACES
	JMP	.+3
	TAD	KM20
	JMS I	OUTDGP	/PRINT A SPACE
	ISZ	SE	/DONE?
	JMP	.-3	/NO-GO ON
	CLA CLL CMA RTL	/MAKE A MINUS 3
	TAD I	FFNGP	/YES-GET SIGN(=-2 OR 0)
	JMS I	OUTDGP	/FOR PLUS OR MINUS-PRINT SIGN
	TAD	KNT	/GET MUL COUNT
	SMA
	JMP I	PRZROP	/PRINT LEADING ZERO
	CMA	IAC	
	JMS I	DGTYPP	/OUTPUT 'KNT' DIGITS
PRDCP,	TAD	DADP	/CHECK DADP FOR 0
	SNA	CLA	/DON'T PRINT '.' IF DADP=0
/*************************************
/FALL THROUGH PAGE BOUNDARY!!!
/'SNA CLA' MUST BE LAST LOC. ON PAGE!!!
/(CURSE YOU B.C.)
/*************************************
*FLPT-1400
/*******FALL THROUGH PAGE BOUNDARY TO HERE*******
	JMP	GKNT	/MUST BE FIRST LOC. OF PAGE!!*******
PDP,	CLA CLL CMA RAL
	JMS	OUTDG	/PRINT DEC. PT.
GKNT,	TAD I	KNTP	/GET COUNT AGAIN
	SPA SNA CLA
	JMP	GD
	TAD I	KNTP	/GET COUNT
	CMA		/NEGATE
	DCA	DGTYP	/STORE AS COUNTER
	TAD	DADP
	CMA		/SAME FOR DADP
	DCA	SEP
	JMP	PR	/GO ON
PZR,	JMS	OUTDG	/PRINT A ZERO
PR,	ISZ	DGTYP
	SKP
	JMP	PS
	ISZ	SEP
	JMP	PZR
PS,	TAD I	KNTP
	CMA	IAC
GD,	TAD	DADP
	SMA	SZA
	JMS	DGTYP
	CLA
	TAD	EFLG
	SZA	CLA
	JMP	DONEF	/DONE
	JMS	OUT
	305		/PRINT 'E'
	TAD	OPX	/GET PRESERVED COUNT OF MULS
	SMA SZA CLA	/DETERMINE SIGN
	CLA CLL CML RTL	/MAKE A 2
	JMS	OUT
	253		/PRINT MINUS OR PLUS SIGN
	TAD	KM144	/SET TO DIV BY 100
	DCA	OPH
	CLA CLL CMA RAL	/SET LOOP COUNTER
	DCA	DGTYP
	TAD	OPX	/GET THE COUNT
	SPA
	CMA	IAC	/NEGATE IF NEGATIVE
LOOP,	DCA	ACLO	/STORE FOR DIV. ROUTINE
	DCA	ACH	/HI ORD. MUST BE ZERO
	CLL		/PREVENT DIVIDE OVERFLOW!!
	JMS I	DV24PT	/DIVIDE BY 100
	TAD	ACLO	/GET THE QUOTIENT
	JMS	OUTDG	/OUTPUT HUNDREDS PLACE
	TAD	KM12	/NOW DIV. BY 10
	DCA	OPH
	TAD	ACH	/DIV. REM. BY 10
	ISZ	DGTYP	/DONE?
	JMP	LOOP	/NO-GO DO CALCULATE , PRINT TENS PLACE
	JMS	OUTDG	/YES-REM(ONES PLACE)IS IN AC-PRINTIT
DONEF,	TAD	SWIT2	/SHOULD WE PRINT CR/LF?
	SNA	CLA
	JMP I	FLING	/NO
	JMS	OUT
	215
	JMS	OUT
	212
	JMP I	FLING
/
/OUTPUT DIGITS OF FAC BY MULTIPLYING BY TEN
/THE HIGH ORDER OVERFLOW IS THE DIGIT
DGTYP,	0
	CMA	IAC
	DCA	SEP	/STORE COUNT PASSED
DT1,	TAD	ACH	/GET FAC AND STORE FOR LATER
	DCA	OPH
	TAD	ACLO
	DCA	OPL
	JMS I	AL1PP	/SHIFT FAC LEFT 1 = FAC*2
	RAL		/OVERFLOW TO TM3
	DCA	TM3
	JMS I	AL1PP	/SHIFT LEFT AGAIN = FAC*4
	TAD	TM3	/SHIFT OUT OVERFLOW
	RAL
	DCA	TM3
	DCA	AC2	/MUST BE 0 FOR OADD
	JMS I	OADDP	/ADD ORIG FAC = FAC*5
	RAL		/ADD OVERFLOW TO TM3
	TAD	TM3
	DCA	TM3
	JMS I	AL1PP	/SHIFT FAC 1 LEFT = FAC*10!!
	TAD	TM3	/OVERFLOW IN TM3 IS FIRST DIGIT
	RAL
	ISZ	DCNT	/DONE ALL SIGNIF. DIGS.?
	JMP	.+3	/NO-GO ON
	CLA	CMA	/YES-PRINT ZEROS
	DCA	DCNT	/FROM NOW ON
	JMS	OUTDG	/PRINT DIGIT (HI ORD. OVRFLOW)
	ISZ	SEP	/DONE REQUIRED?
	JMP	DT1	/NOPE
	JMP I	DGTYP	/YUP
KM144,	-144
KM12,	-12
DV24PT,	DV24
DCNT,	0	/COUNT OF SIGNF. DIGITS
AL1PP,	AL1
OADDP,	OADD
FLING,	FLINK
PRDCPP,	PRDCP
/NEEDED FOR OS/8 BASIC
*FLPT-1234
/
/OUTPUT ROUTINE
/
OUT,	0
	TAD I	OUT	/GET THE CHAR.
	TSF
	JMP	.-1
	TLS
	CLA	CLL	/USE AN 'AND..' INSTEAD???
	JMP I	OUT

/
/OUTPUT DIGIT
/
OUTDG,	0
	JMS	OUT
	260
	JMP I	OUTDG	/RETN

KNTP,	KNT
TM3,	0
	0
SEP,	0
PRNTX,	CLA
	TAD	FLDW	/GET FIELD WIDTH
	CMA		/MUST BE NEGATIVE
	DCA	SEP	/USE AS COUNTER
PRNTX1,	ISZ	SEP	/DONE ALL?
	SKP		/NO-GO ON
	JMP	DONEF	/YES-RETN.
	JMS	OUT	/PRINT ASTERISK
	252		/ASTERISK
	JMP	PRNTX1
/
/PRINT A LEADING ZERO
/
PRZRO,	CLA
	JMS	OUTDG
	JMP I	PRDCPP

/
/FLOATING POINT INPUT ROUTINE
/
*FLPT-1200
FFIN,	0
	CLA	CMA
	DCA I	FDVPT	/INITIALIZE PERIOD SWITCH TO -1
	CMA		/SET SIGN SWITCH TO -1
	DCA	SIGNF
	JMS I	CDFCRA	/CHANGE TO DF OF PACKAGE
	DCA	DSWIT	/ZERO CONVERSION SWITCH
DECONV,	DCA	ACX	/ZERO OUT THE FAC!
	DCA	ACLO
P200,	200
	DCA	ACH
DECNV,	DCA	DNUMBR	/ZERO # OF DIGITS SINCE DEC. PT.
DECON,	JMS	GCHR	/GET A CHAR.FROM TTY.
	JMP	FFIN1	/TERMINATOR-
	ISZ	DSWIT	/DIGIT-BUMP CONVERSION SWITCH
	ISZ	DNUMBR	/BUMP # OF DIGITS-# IS STORED IN
	JMS I	FPP	/FORM EASILY FLOATIBLE-ENTER INTERP.
	FMPY	TEN	/MULTIPLY # BY TEN
	FPUT I	TM3PT	/STORE IT AWAY
	FGET	TP	/GET NEW DIGIT
	FNOR		/FLOAT IT
	FADD I	TM3PT	/ADD IT TO ACCUMULATED #
	FEXT		/DONE
	JMP	DECON	/GO ON
FFIN1,	ISZ I	FDVPT	/HAVE WE HAD A PERIOD YET?
	JMP	FIGO2	/YES-GO ON
	ISZ	TP1	/NO-IS THIS A PERIOD?
	ISZ	TP1
	SKP	CLA
	JMP	DECNV	/YES-ZERO DIG. COUNT AFTER DEC. PT.
			/AND GO CONVERT REST
	DCA	DNUMBR	/NO-TERMINATOR-ZERO COUNT OF
			/DIGITS AFTER DECIMAL POINT.
FIGO2,	ISZ	SIGNF	/IS # NEGATIVE?(DID WE GET - SIGN?)
	JMS I	FFNEGP	/YES-NEGATE IT
	CLA	CMA	/RESET SIGN SWITCH FOR EXP.
	DCA	SIGNF
	TAD	CHAR	/NO-WAS THE TERMINATOR AN 'E'?
	TAD	KME	
	SNA	CLA
GETE,	JMS	GCHR	/YES-GET A CHAR. OF EXPONENT
	JMP	EDON	/END OF EXPONENT
	TAD	TM	/GOT DIG. OF EXP-STORED IN TP1
	CLL	RTL	/MULT. ACCUMULATED EXP BY 10
	TAD	TM
	CLL	RAL
	TAD	TP1	/ADD DIGIT
	JMP	GETE	/CONTINUE
EDON,	TAD	TM	/GET EXPONENT
	ISZ	SIGNF	/WAS EXPONENT NEGATIVE?
	CMA	IAC	/YES-NEGATE IT
	CMA	IAC	/AND CALC. DNUMBR - EXPON.
	TAD	DNUMBR	/GET # TIMES TO DIV MANTISSA BY TEN
	CLL CMA IAC
	SPA		/RESULT POSITIVE?
	CLL CMA CML IAC	/NO-MAKE POS. AND SET LINK
	CMA		/NEGATE FOR COUNTER
	DCA	DNUMBR	/AND STORE
	RAL		/LINK=1-DIV;=0-MUL. # BY TEN
	TAD	MDV	/FORM CORRECT INSTRUCTION
	DCA	SIGNF	/AND STORE FOR EXECUTION
FCNT,	ISZ	DNUMBR	/DONE ALL OPERATIONS?
	JMP	SIGNF	/NO
	JMP I	FFIN	/YES-RETURN
SIGNF,	0		/NO- MUL OR DIV. MANTISSA
	TEN		/BY TEN
	JMP	FCNT	/GO ON
FFNEGP,	FFNEG
TM3PT,	TM3
DNUMBR,	0
KME,	-305
MDV,	JMS I	.+1	/THESE 3 WDS. MUST BE IN THIS ORDER
	FFMPY
FDVPT,	FFDIV		/!!!!!!!!!!!!!!!!!

CDFCRA,	CDFCUR
KK12,	12
TP,	13
TP1,	0
	0
TEN,	4
	2400
	0
/ROUTINE TO GET A CHAR FROM THE TTY AND SEE IF IT IS DIGIT
/OR A TERMINATOR.
/RETURN TO CALL + 1 IF TERMINATOR, TO CALL + 2 IF DIGIT
/THIS ROUTINE MUST NOT MODIFY THE MQ!!
GCHR,	0
	DCA	TM	/STORE ACCUMULATED EXPONENT (MAYBE)
	JMS	INPUT	/GET A CHAR FROM TTY.
	TAD	CHAR	/PICK IT UP
	TAD	PLUS	/WAS IT PLUS SIGN?
	SNA
	JMP	DECON1	/YES-GET ANOTHER CHAR.
	TAD	MINUS	/NO WAS IT MINUS SIGN?
	SZA	CLA
	JMP	.+3
	DCA	SIGNF	/YES-FLIP SWITCH
DECON1,	JMS	INPUT	/GET A CHAR.
	TAD	CHAR
	TAD	K7506	/SEE IF ITS A DIGIT
	CLL
	TAD	KK12
	DCA	TP1	/STORE FOR LATER
	SZL		/DIGIT?
	ISZ	GCHR	/YES-RETN. TO CALL+2
	JMP I	GCHR	/NO-RETN. TO CALL+1
K7506,	7506
/
/INPUT ROUTINE-CHECKS FOR RUBOUT AND CARRIAGE RETURN
/
INPUT,	0
	KSF
	JMP	.-1
	KCC
	TAD	P200	/FORCE CHANNEL 8
	KRS		/READ CHAR.
	DCA	CHAR	/STORE CHAR.
LP,	TAD	CHAR
	DCA	TMIN	/STORE IT AGAIN
	JMS I	OUTPP	/PRINT IT
TMIN,	0
	TAD	CHAR
	TAD	MRUBOT	/IS IT RUBOUT?
	SNA
	JMP	FFIN+1	/YES-RESTART INPUT
	TAD	MCR	/NO-IS IT CARRIAGE RETN.?
	SNA	CLA
	TAD	SWIT1	/YES-SHOULD WE ECHO LINE FEED?
	SZA	CLA
	JMS I	OUTPP	/YES-DO IT
	212		/LINE FEED
	JMP I	INPUT	/RETURN
OUTPP,	OUT
MCR,	377-215
MRUBOT,	-377
PLUS,	-253
MINUS,	253-255

*FLPT-1000
/
/INVERSE FLOATING SUBTRACT-USES FLOATING ADD
/!!FSW1!!-THIS IS OP-FAC
/
FFSUB1,	0
	SNA		/WHICH MODE?
	TAD I	FFSUB1	/CALLED BY USER-GET ADDR. OF OP.
	JMS I	ARGETL	/GO PICK UP OPERAND
	JMS I	FFNEGA	/NEGATE FAC
	TAD	FFSUB1	/AND GO ADD
	JMP I	SUB0P
FFNEGA,	FFNEG
SUB0P,	SUB0
KM22,	-26
/
/INVERSE FLOATING DIVIDE
/FSWITCH=1
/THIS IS OP/FAC
/
FFDIV1,	0
	SNA		/WHICH MODE OF CALL?
	TAD I	FFDIV1	/CALLED BY USER-GET ADDR.
	JMS I	ARGETL	/PICK UP OPERAND
	TAD	ACLO	/SWAP THE FAC AND OPERAND
	DCA	OPL	/THERE IS A POINTER TO OPL
	TAD I	AC2	/IN AC2 LEFT FROM ARGET SUBR.
	DCA	ACLO
	TAD	ACX	/MIGHT AS WELL SUBTRACT THE
	CLL CMA IAC	/EXPONENTS HERE (SAVES A WORD)
	TAD	OPX	/THEN ZERO OPX SO WILL NOT
	DCA	ACX	/MESS UP WHEN ITS DONE AGAIN
	DCA	OPX	/LATER (SEE DIV. ROUTINE)
	TAD	ACH
	DCA	AC2	/NOW SWAP HIGH ORDER MANTISSAS
	TAD	OPH
	DCA	ACH
	TAD	AC2
	DCA	OPH
	JMS I	CDFCRL	/CHANGE DF TO CURRENT
	TAD	FFDIV1	/NOW KLUDGE UP SUBROUTINE LINKAGE
	DCA I	FFDP
	TAD	KFD1
	DCA I	MDSETP
	JMP I	MD1P	/GO SET UP AND DIVIDE

MD1P,	MD1
ARGETL,	ARGET
CDFCRL,	CDFCUR
MDSETP,	MDSET
FFDP,	FFDIV
KFD1,	FFD1
AN1=FFSUB1
AN2=FFDIV1
/FLOATING SQUARE ROOT
/USES A HARDWARE TYPE ALGORITHM FOR BINARY SQUARE ROOTS
/REF: THE LOGIC OF COMPUTER ARITHMETIC-IVAN FLORES-P 409
/
FROOT,	0
	CLA CLL CML RTR	/SET RESULT TO 2000;0000
	DCA	AN1
	DCA	AN2
	JMS I	CDFCRL	/CHANGE TO DATA FIELD OF PACKAGE
	TAD	KM22	/SET COUNTER FOR DEVELOPING 22 BITS OF ERESULT
	DCA	AC2	/ALREADY HAVE 1
	TAD	ACH
	SNA
	JMP I	FROOT	/ZERO FAC-NORMALIZED!-RETN. SAME
	SPA	CLA
	JMS I	FFNEGA	/TAKE ROOT OF ABSOL VALUE
	TAD	ACX	/GET EXPONENT OF FAC
	SPA		/IF NEGATIVE-MUST PROPAGATE SIGN
	CML
	RAR		/DIVIDE EXP. BY 2
	DCA	ACX	/STORE IT BACK
	SZL		/INCREMENT EXP. IF ORIGINAL EXP 
	ISZ	ACX	/WAS ODD
	NOP
	SNL		/DO A PRE-SHIFT FOR EVEN EXPONENTS
	JMS I	AL1K	/SO FIRST BIT PAIR IS 10 NOT 01
	CLA CLL CMA RAL	/SET COUNTER FOR DETECTING A
	DCA	ZCNT	/ZERO REMAINDER
	CLA CLL CML RTR	/SET UP POSITION OF TRIAL BIT
	RTR		/FOR FIRST PASS THRU LOOP
	DCA	OPH
	DCA	OPL
	TAD	K6000	/GET A FAST FIRST BIT-WE KNOW 
	TAD	ACH	/THIS WILL WORK SINCE # IS NORMALIZED
	DCA	ACH	/IF # IS A POWER OF TWO, AND A PERFECT
	TAD	ACH	/SQUARE-WE ARE DONE HERE!
	SNA		/WELL IS IT?
	TAD	ACLO	/COULD BE-CHECK LOW ORDER
	SNA	CLA
	JMP	DONE	/WHOOPPEE-WE WIN BIG.
	JMP	LOP01	/NOPE-LOOP DON'T SHIFT FIRST TIME
SLOOP,	TAD	OPH	/SHIFT TRIAL BIT 1 PLACE
	CLL	RAR	/TO THE RIGHT
	DCA	OPH	/AND STORE BACK
	TAD	OPL
	RAR
	DCA	OPL
	JMS I	AL1K	/SHIFT FAC LEFT 1 PLACE
LOP01,	TAD	OPL	/ADD TRIAL BIT TO`ANSWER
	TAD	AN2	/SO FAR
	CLL CMA IAC	/NEGATE IT
	TAD	ACLO	/AND ADD TO FAC (REMAINDER SO FAR)
	SNA		/IS RESULT ZERO?
	ISZ	ZCNT	/YES-INCREMENT COUNTER
	DCA	TM	/STORE RESULT IN TEMPORARY

	CML	RAL	/ADD CARRY TO HIGH ORDER FOR SUBTRACT
	TAD	OPH	/ADD TRIAL BIT
	TAD	AN1	/ADD RESULT SO FAR (HI ORDER)
	CLL CMA IAC	/AND SUBTRACT FROM HI ORDER FAC
	TAD	ACH
	SNL		/RESULT NEGATIVE?
	JMP	GON	/YES-NEXT RESULT BIT IS 0
	SZA		/NO-IS HI ORDER RESULT=0?
	JMP	LOP02	/NO-GO ON
	ISZ	ZCNT	/YES-WAS LOW ORDER =0?
	JMP	.+3	/NO-GO ON
	CMA		/YES-REM.=0-SET COUNTER SO
	DCA	AC2	/LOOKS LIKE WE'RE DONE
LOP02,	DCA	ACH	/STORE HIGH ORDER REM. IN FAC
	TAD	TM	/STORE LO ORDER REM. IN FAC
	DCA	ACLO
	TAD	OPL	/TRIAL BIT SHIFTED LEFT 1 IS
	CLL	RAL	/RESULT BIT-ADD IT TO ROOT DEVELOPED
	TAD	AN2	/SO FAR
	DCA	AN2
	TAD	OPH
	RAL
	TAD	AN1
	DCA	AN1
GON,	CLA CLL CMA RAL	/RESET COUNTER FOR ZERO REM.
	DCA	ZCNT	
	ISZ	AC2	/DONE ALL 23 RESULT BITS?
	JMP	SLOOP	/NO-GO ON
DONE,	TAD	AN1	/YES-STORE ANSWER IN FAC
	DCA	ACH	/ITS NORMALIZED ALREADY
	TAD	AN2
	DCA	ACLO
	JMP I	FROOT	/AND RETURN

K6000,	6000
ZCNT,	0
AL1K,	AL1
PAUSE
/23-BIT FLOATING PT INTERPRETER
*FLPT-600
/FLOATING MULTIPLY-DOES 2 24X12 BIT MULTIPLIES
FFMPY,	0
	SNA		/WHICH MODE OF CALL?
	TAD I	FFMPY	/CALLED BY USER-GET OPERAND ADDR.
	JMS I	MDSETK	/SET UP FOR MPY-OPX IN AC ON RETN.
	TAD	ACX	/DO EXPONENT ADDITION
	DCA	ACX	/STORE FINAL EXPONENT
	DCA	DV24	/ZERO TEM STORAGE FOR MPY ROUTINE
	DCA	AC2
	TAD	ACH	/IS FAC=0?
	SNA	CLA
	DCA	ACX	/YES-ZERO EXPONENT
	JMS	MP24	/NO-MULTIPLY FAC BY LOW ORDER OPR.
	TAD	OPH	/NOW MULTIPLY FAC BY HI ORDER MULTIPLIER
	DCA	OPL
	JMS	MP24
	TAD	AC2	/STORE RESULT BACK IN FAC
RTZRO,	DCA	ACLO	/LOW ORDER
	TAD	DV24	/HIGH ORDER
	DCA	ACH
	TAD	ACH	/DO WE NEED TO NORMALIZE?
	RAL
	SMA	CLA
	JMP	SHLFT	/YES-DO IT FAST
MDONE,	DCA	AC1	/NO-ZERO OVERFLOW WD(DO I NEED THIS???)
	ISZ	FFMPY	/BUMP RETURN POINTER
	ISZ	TM	/SHOULD RESULT BE NEGATIVE?
	JMP I	FFMPY	/NOPE-RETN.
	JMS I	FFNEGR	/YES-NEGATE IT
	JMP I	FFMPY	/RETURN
SHLFT,	CMA		/SUBTRACT 1 FROM EXP.
	TAD	ACX
	DCA	ACX
	JMS I	AL1PTR	/SHIFT FAC LEFT 1 BIT
	JMP	MDONE+1	/DONE.
AL1PTR,	AL1
/
/24 BIT BY 12 BIT MULTIPLY.  MULTIPLIER IS IN OPL
/MULTIPLICAND IS IN ACH AND ACLO
/RESULT LEFT IN DV24,AC2, AND AC1
MP24,	0
	TAD	KKM12	/SET UP 12 BIT COUNTER
	DCA	OPX
	TAD	OPL	/IS MULTIPLIER=0?
	SZA
	JMP	MPLP1	/NO-GO ON
	DCA	AC1	/YES-INSURE RESULT=0
	JMP I	MP24	/RETURN
MPLP,	TAD	OPL	/SHIFT A BIT OUT OF LOW ORDER
MPLP1,	RAR		/OF MULTIPLIER AND INTO LINK
	DCA	OPL
	SNL		/WAS IT A 1?
	JMP	MPLP2	/NO-0-JUST SHIFT PARTIAL PRODUCT
	CLL		/YES-ADD MULTIPLICAND TO PARTIAL PRODUCT
	TAD	AC2
	TAD	ACLO	/LOW ORDER
	DCA	AC2
	RAL		/PROPAGATE CARRY
	TAD	ACH	/HI ORDER
MPLP2,	TAD	DV24
	RAR		/NOW SHIFT PARTIAL PROD. RIGHT 1 BIT
	DCA	DV24
	TAD	AC2
	RAR
	DCA	AC2
	RAR		/1 BIT OF OVERFLOW TO AC1
	DCA	AC1
	ISZ	OPX	/DONE ALL 12 MULTIPLIER BITS?
	JMP	MPLP	/NO-GO ON
	JMP I	MP24	/YES-RETURN
/
/PART OF DIVIDE ROUTINE-FFDIV MUST BE AT LOC. 6722
MP12L,	DCA	OPL	/STORE BACK MULTIPLIET
	TAD	AC2	/GET PRODUCT SO FAR
	SNL		/WAS MULTIPLIER BIT A 1?
	JMP	.+3	/NO-JUST SHIFT THE PARTIAL PRODUCT
	CLL		/YES-CLEAR LINK AND ADD MULTIPLICAND
	TAD	ACLO	/TO PARTIAL PRODUCT
	RAR		/SHIFT PARTIAL PRODUCT-THIS IS HI ORDER
	DCA	AC2	/RESULT-STORE BACK
DVLP1,	TAD	OPL	/SHIFT A BIT OUT OF MULTIPLIER
	RAR		/AND A BIT OR RESLT. INTO IT (LO ORD. PROD.)
	ISZ	FFMPY	/DONE ALL BITS?
	JMP	MP12L	/NO-LOOP BACK
	CLL CMA IAC	/YES-LOW ORDER PROD. OF QUOT. X OPL IN AC
	DCA	ACLO	/NEGATE AND STORE
	CML	RAL	/PROPAGATE CARRY
	JMP I	FD1P	/GO ON
FD1P,	FD1	/POINTER TO REST OF DIVIDE ROUTINE
/
/FLOATING DIVIDE ROUTINE
/USES THE METHOD OF TRIAL DIVISION BY HI ORDER
FFDIV,	0		/(USED AS A TEM. BY I/O ROUTINES)
	SNA		/WHICH MODE OF CALL?
	TAD I	FFDIV	/CALLED BY USER-GET ARG. ADDR.
	JMS I	MDSETK	/GO SET UP FOR DIVIDE-OPX IN AC ON RETN.
FFD1,	CMA	IAC	/NEGATE EXP. OF OPERAND
	TAD	ACX	/ADD EXP OF FAC
	DCA	ACX	/STORE AS FINAL EXPONENT
	TAD	OPH	/NEGATE HI ORDER OP. FOR USE
	CLL CMA IAC	/AS DIVISOR
	DCA	OPH
	JMS	DV24	/CALL DIV.--(ACH+ACLO)/OPH
	TAD	ACLO	/SAVE QUOT. FOR LATER
	DCA	AC1
	TAD	KM13	/SET COUNTER FOR 12 BIT MULTIPLY
	DCA	FFMPY	/TO MULTIPLY QUOT. OF DIV. BY 
	JMP	DVLP1	/LOW ORDER OF OPERAND (OPL)
/
/END OF FLOATING DIVIDE-FUDGE SOME
/STUFF THEN JUMP INTO MULTIPLY
/
FDDON,	TAD	FFDIV	/STORE RETN. ADDR. IN MULT ROUTINE
	DCA	FFMPY
	JMP	MDONE	/GO CLEAN UP
/
/DIVIDE ROUTINE--24 BITS IN ACH,ACLO ARE DIVIDED BY 12 BITS
/IN OPH.  OPH IS ASSUMEN NEGATIVE AND .GT. ACH IN ABSOLUTE VALUE
/ELSE-DIVIDE OVERFLOW--WE RETURN NORMALLY WITH QUOTIENT
/IN ACLO AND REM. IN ACH.  (AC2=0 ON RETN.)
/
DV24,	0
	TAD	ACH	/CHECK THAT DIVISOR IS .GT. DIVIDEND
	TAD	OPH	/DIVISOR IN OPH (NEGATIVE)
	SZL	CLA	/IS IT?
	JMP I	DVOVR	/NO-DIVIDE OVERFLOW
	TAD	KM13	/YES-SET UP 12 BIT LOOP
	DCA	AC2
	JMP	DV1	/GO BEGIN DIVIDE
DV2,	TAD	ACH	/CONTINUE SHIFT OF FAC LEFT
	RAL
	DCA	ACH	/RESTORE HI ORDER
	TAD	ACH	/NOW SUBTRACT DIVISOR FROM HI ORDER
	TAD	OPH	/DIVIDEND
	SZL		/GOOD SUBTRACT?
	DCA	ACH	/YES-RESTORE HI DIVIDEND
	CLA		/NO-DON'T RESTORE--OPH.GT.ACH
DV1,	TAD	ACLO	/SHIFT FAC LEFT 1 BIT-ALSO SHIFT
	RAL		/1 BIT OF QUOT. INTO LOW ORD OF ACLO
	DCA	ACLO
	ISZ	AC2	/DONE 12 BITS OF QUOT?
	JMP	DV2	/NO-GO ON
	JMP I	DV24	/YES-RETN W/AC2=0
FFNEGR,	FFNEG
MDSETK,	MDSET
KKM12,	-14
KM13,	-15
DVOVR,	FTRP2

*FLPT-400
/
/FLOATING ADD
/
FFADD,	0
	SNA		/WHICH MODE FO CALL?
	TAD I	FFADD	/CALLED BY USER-GET ADDR. OF OPR.
	JMS I	ARGETP	/PICK UP OPERAND
FAD1,	JMS I	CDFCRP	/CHANGE TO FIELD OF PACKAGE
	TAD	OPH	/IS OPERAND = 0
	SNA	CLA
	JMP	DONA	/YES-DONE
	TAD	ACH	/NO-IS FAC=0?
	SNA	CLA
	JMP	DOADD	/YES-DO ADD
	TAD	ACX	/NO-DO EXPONENT CALCULATION
	CLL CMA IAC
	TAD	OPX
	SMA	SZA	/WHICH EXP. GREATER?
	JMP	FACR	/OPERANDS-SHIFT FAC
	CMA	IAC	/FAC'S-SHIFT OPERAND=DIFFRNCE+1
	JMS	OPSR
	JMS	ACSR	/SHIFT FAC ONE PLACE RIGHT
DOADD,	TAD	OPX	/SET EXPONENT OF RESULT
	DCA	ACX
	JMS	OADD	/DO THE ADDITION
	JMS I	FNORP	/NORMALIZE RESULT
DONA,	ISZ	FFADD	/BUMP RETURN
	JMP I	FFADD	/RETURN
FACR,	JMS 	ACSR	/SHIFT FAC = DIFF.+1
	JMS	OPSR	/SHIFT OPR. 1 PLACE
	JMP	DOADD	/DO ADDITION
/
/OPERAND SHIFT RIGHT-ENTER WITH POSITIVE COUNT-1
/IN AC
OPSR,	0
	CMA		/- (COUNT+1) TO SHIFT COUNTER
	DCA	AC0
LOP2,	TAD	OPH	/GET SIGN BIT
	RAL		/TO LINK
	CLA
	TAD	OPH	/GET HI MANTISSA
	RAR		/SHIFT IT RIGHT, PROPAGATING SIGN
	DCA	OPH	/STORE BACK
	TAD	OPL
	RAR
	DCA	OPL	/STORE LO ORDER BACK
	RAR		/SAVE 1 BIT OF OVERFLOW
	DCA	AC2	/IN AC2
	ISZ	OPX	/INCREMENT EXPONENT
NOP2,	NOP	
	ISZ	AC0	/DONE ALL SHIFTS?
	JMP	LOP2	/NO-LOOP
	JMP I	OPSR	/YES-RETN.
/
/SHIFT FAC LEFT 1 BIT
/
AL1,	0
	TAD	AC1	/GET OVERFLOW BIT
	CLL	RAL	/SHIFT LEFT
	DCA	AC1	/STORE BACK
	TAD	ACLO	/GET LOW ORDER MANTISSA
	RAL		/SHIFT LEFT
	DCA	ACLO	/STORE BACK
	TAD	ACH	/GET HI ORDER
	RAL
	DCA	ACH	/STORE BACK
	JMP I	AL1	/RETN.
/
/SHIFT FAC RIGHT-ENTER WITH COUNT-1 IN AC (POSITIVE)
/
ACSR,	0
	CMA	/AC CONTAINS COUNT-1
	DCA	AC0	/STORE COUNT
LOP1,	TAD	ACH	/GET SIGN BIT OF MANTISSA
	RAL		/SET UP SIGN PROPAGATION
	CLA
	TAD	ACH	/GET HIGH ORDER MANTISSA
	RAR		/SHIFT RIGHT`1, PROPAGATING SIGN
	DCA	ACH	/STORE BACK
	TAD	ACLO	/GET LOW ORDER
	RAR		/SHIFT IT
	DCA	ACLO	/STORE BACK
	RAR
	DCA	AC1	/SAVE 1 BIT OF OVERFLOW
	ISZ	ACX	/INCREMENT EXPONENT
NOP1,	NOP
	ISZ	AC0	/DONE?
	JMP	LOP1	/NO-LOOP
	JMP I	ACSR	/YES-RETN-AC=L=0
/
/DIVIDE OVERFLOW-ZERO ACX,ACH,ACLO
/
DBAD,	CLA	CLL	/NECESSARY SO WE DON'T GET OVRFLO AGAIN
	JMP I	DBAD1P	/GO ZERO ALL
/
/FLOATING SUBTRACT
/
FFSUB,	0
	SNA		/WHICH MODE OF CALL?
	TAD I	FFSUB	/CALLED BY USER-GET ADDR. OF OP
	JMS I	ARGETP	/PICK UO THE OP.
	JMS	OPNEG	/NEGATE OPERAND
	TAD	FFSUB	/JMP INTO FLTG. ADD
SUB0,	DCA	FFADD	/AFTER SETTING UP RETURN
	JMP	FAD1
ARGETP,	ARGET

/
/FLOATING HALT-DISPLAY FLOATING P.C.
/
FFHLT,	JMS I	CDFCRP	/MUST BE DATA FIELD OF PACKAGE
	TAD I	FPP	/GET THE P.C.
	HLT
	CLA		/CLR IT OUT
	JMP I	FPNXT	/DONE-GET NEXT INSTR.
/
/FLOATING NEGATE
/
FFNEG,	0		/(USED AS A TEM. BY OUTPUT ROUTINE)
	TAD	ACLO	/GET LOW ORDER FAC
	CLL CMA IAC	/NEGATE IT
	DCA	ACLO	/STORE BACK
	CML	RAL	/ADJUST OVERFLOW BIT AND
	TAD	ACH	/PROPAGATE CARRY-GET HI ORD
	CLL CMA IAC	/NEGATE IT
	DCA	ACH	/STORE BACK
	JMP I	FFNEG
/
/NEGATE OPERAND
/
OPNEG,	0
	TAD	OPL	/GET LOW ORDER
	CLL CMA IAC	/NEGATE AND STORE BACK
	DCA	OPL
	CML	RAL	/PROPAGATE CARRY
	TAD	OPH	/GET HI ORDER
	CLL CMA IAC	/NEGATE AND STORE BACK
	DCA	OPH
	JMP I	OPNEG
/
/ADD OPERAND TO FAC
/
OADD,	0
	CLL
	TAD	AC2	/ADD OVERFLOW WORDS
	TAD	AC1
	DCA	AC1
	RAL		/ROTATE CARRY
	TAD	OPL	/ADD LOW ORDER MANTISSAS
	TAD	ACLO
	DCA	ACLO
	RAL
	TAD	OPH	/ADD HI ORDER MANTISSAS
	TAD	ACH
	DCA	ACH
	JMP I	OADD	/RETN.
DBAD1P,	DBAD1
CDFCRP,	CDFCUR
FNORP,	FFNOR
*FLPT-200
/
/ROUTINE TO CALL EXTENDED FUNCTIONS
/THIS IS AN EXTENSION OF OP CODE 0
/
FCALL,	TAD	OPH	/FCALL-GET FUNCTION # (=ADDR SINCE
	TAD	JMSI2	/PAGE ZERO)-MAKE A JMS THRU TABLE
	DCA	DCOD1	/STORE IT
	JMS	CDFCUR	/D.F. MUST BE FIELD OF PACKAGE
	TAD I	FPP	/GET AND SAVE FLTG. P.C.
	DCA	FT1
	TAD I	DFCDFP	/GET AND SAVE FLTG. D.F. AND I.F.
	DCA	FT2
	TAD I	FPNXT
	DCA	FT3
DCOD1,	0		/CALL THE SUBROUTINE
	CLA
	JMS	CDFCUR	/CHANGE TO D.F. OF PACKAGE
	TAD	FT3	/RESTORE FLTG. PC,IF,DF
	DCA I	FPNXT
	TAD	FT2
	DCA I	DFCDFP
	TAD	FT1
FJUMP1,	DCA I	FPP
	JMP I	FPNXT	/GET NEXT INSTR.
/
/CONTINUATION OF NORMALIZE ROUTINE
/
FFNORR,	DCA	AC1	/DONE W/NORMALIZE-CLEAR AC1
	JMP I	FFNOR	/RETURN
AL1P,	AL1
JMPIC,	JMP I	CDFCUR
DFCDFP,	DFCDF
JMSI2,	JMS I	TABLE2-1
TABLE2,	FFSQ		/SQUARE=1
	FROOT		/SQUARE ROOT=2
	FFSIN		/SIN=3
	FFCOS		/COS=4
	FFATN		/ARCTANGENT=5
	FFEXP		/EXPONENTIAL=6
	FFLOG		/LOGARITHM=7
	FFNEG		/NEGATE=10
	FFIN		/INPUT=11
	FFOUT		/OUTPUT=12
	FFIX		/FIX=13
	FFLOAT		/FLOAT=14
	DCOD1		/NOP=15
	DCOD1		/NOP=16
	DCOD1		/NOP=17

/
/ARGUMENT PICK UP ROUTINE-ENTER WITH DATA FIELD SET TO EITHER
/FLTG. DATA FIELD OR FLTG. INSTR. FIELD.
/ADDRESS OF OPERAND IS IN THE AC ON ENTRY.
/ON RETURN, THE`AC IS CLEAR
/
ARGET,	0
	DCA	AC2	/STORE ADDRESS OF OPERAND
	TAD I	AC2	/PICK UP EXPONENT
	DCA	OPX
	ISZ	AC2	/MOVE POINTER TO HI MANTISSA WD
	TAD I	AC2	/PICK IT UP
	DCA	OPH	/STORE
	ISZ	AC2	/MOVE PTR. TO LO MANTISSA WD.
	TAD I	AC2	/PICK IT UP
	DCA	OPL	/STORE IT
	JMP I	ARGET	/RETURN
DVOP2P,	DVOP2
/
/ROUTINE TO NORMALIZE THE FAC
/
FFNOR,	0
	TAD	ACH	/GET THE HI ORDER MANTISSA
	SNA		/ZERO?
	TAD	ACLO	/YES-HOW ABOUT LOW?
	SNA
	TAD	AC1	/LOW=0, IS OVRFLO BIT ON?
	SNA	CLA
	JMP	ZEXP	/#=0-ZERO EXPONENT
NORMLP,	CLA CLL CML RTR	/NOT 0-MAKE A 2000 IN AC
	TAD	ACH	/ADD HI ORDER MANTISSA
	SZA		/HI ORDER = 6000
	JMP	.+3	/NO-CHECK LEFT MOST DIGIT
	TAD	ACLO	/YES-6000 OK IF LOW=0
	SZA	CLA	
	SPA	CLA	/2,3,4,5,ARE LEGAL LEFT MOST DIGS.
	JMP	FFNORR	/FOR NORMALIZED #-(+2000=4,5,6,7)
	JMP	FNLP	/JUMP SO FFGET AND PUT ARE ORGED RIGHT
/
/FLOATING GET
/
FFGET,	0
	SNA		/WHICH MODE OF CALL
	TAD I	FFGET	/CALLED BY USER-GET ADDR. OF OP
	JMS	ARGET	/PICK UP OPERAND
	TAD	OPX
	DCA	ACX	/LOAD THE OPERAND INTO FAC
	TAD	OPL
	DCA	ACLO
	TAD	OPH
	DCA	ACH
	ISZ	FFGET
	JMP I	FFGET	/RETN. TO CALL +2
/
/FLOATING PUT
/
FFPUT,	0
	SNA		/WHICH MODE OF CALL?
	TAD I	FFPUT	/CALLED BY USER-GET OPR. ADDR
	DCA	FFGET	/STORE IN A TEMP
	TAD	ACX	/GET FAC AND STORE IT
	DCA I	FFGET	/AT SPECIFIED ADDRESS
	ISZ	FFGET
	TAD	ACH
	DCA I	FFGET
	ISZ	FFGET
	TAD	ACLO
	DCA I	FFGET
	ISZ	FFPUT	/BUMP RETN.
	JMP I	FFPUT	/RETN. TO CALL+2
/
/ROUTINE TO ADJUST QUOTINET OF FIRST DIVIDE (MAYBE) WHEN THE
/REMAINDER OF THE FIRST`DIVIDE IS LESS THAN QUOT*OPL
/USED BY FLTG. DIVIDE ROUTINE
/
DVOPS,	CMA	IAC	/NEGATE AND STORE REVISED REMAINDER
	DCA	ACH	
	CLL
	TAD	OPH
	TAD	ACH	/WATCH FOR OVERFLOW
	SNL
	JMP	DVOP1	/OVERFLOW-DON'T ADJUST QUOT. OF 1ST DIV.
	DCA	ACH	/NO OVERFLOW-STORE NEW REM.
	CMA		/SUBTRACT 1 FROM QUOT OF
	TAD	AC1	/FIRST DIVIDE
	DCA	AC1
DVOP1,	CLA 	CLL
	TAD	ACH	/GET HI ORD OF REMAINDER
	JMP I	DVOP2P	/GO ON

/
/CHANGE TO DATA FIELD OF FLTG. PT. PKG.
/AFTER FIRST TIME THRU, ROUTINE LOOKS LIKE
/
/	CDFCUR,	0
/		CDF	N	/N IS FLD OF PKG.
/		JMP I	CDFCUR
/		(NEXT 8 LOCS. FREE FOR TEMPS)
/
CDFCUR,	0
CCUR1,	RIF		/READ INST. FIELD
CCUR2,	TAD	TM	/ADD A CDF 0 INST
	DCA	CCUR1	/STORE IT, MODIFYING SUBR.
	TAD	JMPIC	/STORE A SUBR. RETN
	DCA	CCUR2	/ALL DONE
/
/NECESSARY CONSTANTS
/
	7100
FT2,	7076
FT3,	7650
FT1,	2262
	5357

FNLP,	CLL CML CMA	/-1
	TAD	ACX	/SUBTR. 1 FROM EXPONENT
	DCA	ACX
	JMS I	AL1P	/SHIFT FAC LEFT 1
	JMP	NORMLP	/GO BACK AND SEE IF NORMALIZED
ZEXP,	DCA	ACX
	JMP	FFNORR
/
/BEGINNING OF INTERPRETER
/
*FLPT
FPT,	0
L7600,	7600		/CLA
	RDF		/READ DATA FIELD-THIS WILL BE
	TAD	KCDF0	/INITIAL FLTG. DATA AND INSTR. FLD
	DCA	FPNEXT	/STORE CDF TO FLTG. INST. FLD
FFSW0,	TAD	FFSB0	/INLINE IN INTERPRETER--SET FLOATING SWITCH
	DCA	TSUB	/TO 0
	TAD	FFDV0
	DCA	TDIV
	TAD	FPNEXT
SFDF,	DCA	DFCDF
FPNEXT,	0		/BECOMES CDF TO FLTG. INST FLD.
	TAD I	FPT	/GET NEXT FLTG. PT. INSTR.
	DCA	OPX	/STORE IN A TEMPORARY
	TAD	OPX	/GET IT BACK AND PICK OFF
	AND	K177	/THE ADDRESS
	DCA	OPH	/STORE THAT AWAY
	TAD	OPX	/PICK OFF THE PAGE BIT
	AND	K200	/AND MAKE A 7600 IF CURRENT PAGE
	CMA	IAC	/OR 0 IF PAGE ZERO
K200,	AND	FPT	/THIS SETS UP HI ORDER 5 BITS OF ADDR.
	ISZ	FPT	/INCREMENT FLTG. P.C.
	TAD	OPH	/ADD IN LOW ORDER 7 BITS OF ADDR
	DCA	OPH	/THIS IS FINAL ADDR UNLESS INDIRECT.
	TAD	OPX	/NOW DECODE THE OP CODE
	CLL	RTL
	RTL
	AND	K7	/PICK OFF OP CODE BITS
	TAD	JMSI	/AND MAKE A JMS THRU TABLE
	DCA	DCOD	/STORE IT FOR LATET
	TAD	OPH	/GET ADDRESS INTO AC
	SNL		/INDIRECT BIT IN LINK-IS IT ON?
	JMP	DCOD	/NO-CALL THE PROPER ROUTINE
	AND	K7770	/YES-IS ADDR AN AUTO INDEX REG.?
	TAD	K7770
	SNA	CLA	
	TAD	K3	/YES-ADD 3 TO XREG. BEFORE USING
	TAD I	OPH	/THE ADDR.
	DCA I	OPH
	TAD I	OPH	/GET EFF. ADDR.INTO AC FOR CALL
DFCDF,	0		/CHANGE TO FLTG. D.F.-INDIREDT ADDRESSING
DCOD,	0		/CALL SUBRS. WITH ADDR IN AC-D.F.IS
			/SET TO FLTG. D.F. OR I.F.-RETN. IS 
			/TO CALL+2
FNRM,	JMS I	FFNORP	/NORMALIZE ROUTINE-CALL NORM SUBR.
	JMP	FPNEXT	/GO GET NEXT INSTR.
/
/TABLE FOR JUMPS
/
JMSI,	JMS I	TABLE
TABLE,	FFJMP		/FLOATING JMP OP CODE 0
	FFADD		/    "    ADD   "  1
TSUB,	FFSUB		/    "    SUBTRACT 2
TMPY,	FFMPY		/    "    MULTIPLY 3
TDIV,	FFDIV		/    "    DIVIDE   4
	FFGET		/    "    GET   "  5
	FFPUT		/    "    PUT   "  6
	FFJMS		/    "    JMS   "  7
/
/CONSTANTS AND POINTERS
/
K177,	177
FCALLP,	FCALL
KCDF0,	CDF	0
K7770,	7770
FFNORP,	FFNOR
/
/FLOATING JUMP-CHECK FOR FCALL OR FISZ
/
FFJMP,	0
	SNA		/IS IT FEXT?
	JMP	EXIT	/YES-LEAVE INTERPRETER
	DCA	OPH	/NO-STORE ADDR.
	TAD	OPX	/ARE INDIRECT AND PAGE BITS=0
	AND	L7600	/(WORKS SINCE OP`CODE=0)
	SZA	CLA
	JMP	FJUMP	/NO-IT IS FJUMP-EFF. ADR. IN OPH
	TAD	OPX	/YES-ARE BITS 5-7=0?
	AND	K160	/(ANY ON=FISZ)
	SNA	CLA
	JMP I	FCALLP	/FLOATING CALL-DO IT
FFISZ,	ISZ I	OPX	/FISZ-ISZ THAT ADDR (DF=FLTG. IF)
	JMP	FPNEXT	/NO-SKIP-GO GET NEXT INST.
FISZ1,	ISZ	FPT	/SKIP-INCREMENT FLTG. P.C.
	JMP	FPNEXT	/GO ON
K160,	160
/
/FEXT-LEAVE INTERPRETER
/
EXIT,	CLA CLL CML RTL	/MAKE A CDF CIF TO FLTG. INST FLD.
	TAD	FPNEXT
	DCA	.+1	/STORE IT
	0
	JMP I	FPT	/GO BACK TO USER,AC=L=0
/
/FLOATING JMS-IF BITS    3-11=0 = NORMALIZE FAC (FNOR)
/		  "      3-4 =0 = DECODE FURTHER BY BITS 9-11
/		  "	 9-11=0 = SKIP ON CONDITION OF FAC
/		  "  	     =1 = FCDF (BITS 6-8=NEW FLTG. D.F.)
/		  "          =2 = FSW0
/		  "          =3 = FSW1
/		  "          =4 = FHLT-DISPLAY FLTG. PC
/		  "          =5-7 NOP
/
FFJMS,	0
	SNA		/IS IT NORMALIZE?
	JMP	FNRM	/YEAH-DO IT
	DCA	OPH	/NO-STORE EFF ADDR.
	TAD	OPX	/GET THE INSTR.
	AND	K600	/INDIRECT AND PAGE BITS=0?
	SNA	CLA
	JMP I	JSKPP	/YES-GO DECODE FURTHER
	TAD	FPNEXT	/NO-ITS JMS-GET CDF TO FLTG. I.F.
	DCA	.+1	/STORE IT
IFCDF,	0		/EXECUTE IT
	TAD	FPT	/GET THE FLTG. P.C.
	DCA I	OPH	/STORE IT AT THE EFF.ADDR.
	TAD	OPH	/GET THE EFF. ADDR.
	DCA	FPT	/STORE IN`FLTG. PC.
	JMP	FISZ1	/GO INCREMENT FLTG. PC
JSKPP,	JSKP
FFDV0,	FFDIV
FFSB0,	FFSUB
K3,	3
K7,	7
K600,	600
/
/FLOATING SKIP-ADD 600 TO THE INSTRUCTION TO MAKE IT
/A SKIP WITH CLA--THE SKIP PRODUCED IS THE REVERSE OF
/WHAT IS EXPECTED  (SNA NOT SZA) TO FACILITATE THE
/DECODING
/
FFSKP,	TAD	K600	/ADD 600 TO MAKE A SKP WITH CLA
	TAD	OPX	/ADD IN ORIG INSTR
	DCA	.+2
	TAD	ACH	/GET HI ORDER MANTISSA IN FAC FOR SENSING
	0		/EXECUTE THE SKIP WE MADE
	ISZ	FPT	/NO SKIP=SKIP-BUMP FLTG.PC
	JMP	FPNEXT	/SKIP=NO SKIP-LEAVE PC ALONE-GO ON

/
/FLOATING JUMP-STORE EFF. ADDR IN FLTG.PC
/
FJUMP,	TAD	OPH	/GET EFF ADDR OF JUMP
	DCA	FPT	/STORE IN FLTG. PC
	JMP	FPNEXT	/GO ON
/
/FCDF-BITS 6-8 ARE NEW FLTG. DATA FIELD
/
FFCDF,	CLA	CMA	/SUBTRACT 1 FROM EFF. ADDR.
	TAD	OPH	/ADD IN FIELD BITS
	TAD	KCDF0	/ADD IN CDF INSTR.
	JMP	SFDF	/GO SOTER CDF TO FLTG DF.

*FPT+164
/
/FSQUARE-SQUARE FAC-CALLS MULTIPLY TO MUL. FAC BY ITSELF
/
FFSQ,	0
	JMS I	TMPY	/CALL MULTIPLY TO MULTIPLY
	ACX		/FAC BY ITSELF
	JMP I	FFSQ	/DONE
/
/FLOATING TRAPS TO USER-INITIALLY SET TO NOPS
/
FTRP1,	JMP I	FTRAP1	/OVERFLOW
FTRP2,	JMP I	FTRAP2	/DIV. ERR.
FTRP3,	JMP I	FTRAP3	/ILL. FUNCT. ARG.
FTRP4,	JMP I	FTRAP4	/UNDERFLOW
FTRAP1,	FTRPRT
FTRAP2,	DBAD
FTRAP3,	LTRPRT
FTRAP4,	DCOD1+1
$