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

/5-23-72       R BEAN

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

/DEC-08-NFPEA-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
	JMS I SPLITA	/SPLIT UP FAC (UNPACK IT)
	DCA I SPLTFK	/CLEAR SPLIT FLAG!!
	TAD EXP		/FETCH EXPONENT
	TAD FTRPRT	/SUBTRACT THE BIAS
	SZA SMA		/IS NUMBER <1?
	 JMP .+3	/NO-CONTINUE ON
FTRPRT,	7600		/CLA=-200
	JMP FIXDNE	/YES-FIX IT TO ZERO
	TAD M13		/SET BINARY POINT AT 11 PLACES TO
	SMA SZA		/RIGHT OF CURRENT POINT IS # TOO BIG?
	 JMP I OTRAPA	/YES-TAKE OVERFLOW TRAP
	TAD M4		/NO-ADD 4 SINCE AC1 HAS SOME BITS
	DCA EXP		/SET SCALE COUNT
FIXLP,	JMS I AR1A	/SHIFT FAC RIGHT 1 PLACE
	DCA LORD	/ZERO LORD SO OV WILL BE 0
	ISZ EXP		/DONE YET?
	 JMP FIXLP	/NO
	TAD TM		/YES-PUT SIGN OF MANTISSA
	CLL RAL		/IN LINK
	TAD HORD	/GET HIGH ORDER MANTISSA
	SZL		/WAS ORIGINAL # NEGATIVE?
	  CLL CMA IAC	/YES-NEGATE THIS AND CLR. LINK
FIXDNE,	DCA EXP		/RETURN WITH ANSWER IN 44
	JMP I FFIX	/RETURN

M4,	-4		/-4 DECIMAL
M13,	-13		/-11 DECIMAL

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

FFLOAT,	0
	CLL
	TAD EXP
	SPA 		/IS IT NEGATIVE?
	  CML CMA IAC	/YES-MAKE POSITIVE AND SET LINK
	DCA HORD	/PUT NUMBER IN HI MANTISSA
	DCA LORD	/CLEAR LOW MANTISSA
	RAR		/ROTATE SIGN FROM LINK
	TAD C2170	/15(10)+ SIGN INTO EXPONENT
	DCA EXP
	JMS I FNORL	/NORMALIZE
	JMP I FFLOAT	/RETURN
FNORL,	FFNOR		/LINK TO NORMALIZE ROUTINE
C2170,	2170		/15 DECIMAL
OTRAPA,	FTRP1		/ADDRESS OF VECTOR FOR OVERFLOW TRAP

LOGC5,	2004		/.59897865
	6253
	2522
LN2,	2005		/.69314718
	4271
	0300
TOVPI,	2005		/.6366198 = 2/PI
	0574
	6033
TEMP1,	0
	0
	0
TEMP2,	0		/TWO TEMP STORAGE BLOCKS FOR FUNCTIONS
	0
	0
SPLTFK,	SPLTFG
SPLITA,	SPLIT
AR1A,	AR1
*FIXFLT-500

/******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 QDTBL

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	/A9(U)
	  SINA9
	JMS I FADDL	/A7+A9(U)
	  SINA7
	JMS I FMPYL	/A7(U)+A9(U**2)
	  TEMP2
	JMS I FADDL	/A5+A7(U)+A9(U**2)
	  SINA5
	JMS I FMPYL	/A5(U)+A7(U**2)+A9(U**3)
	  TEMP2
	JMS I FADDL	/A3+A5(U)+A7(U**2)+A9(U**3)
	  SINA3
	JMS I FMPYL	/A3(U)+A5(U**2)+A7(U**3)+A9(U**4)
	  TEMP2
	JMS I FADDL	/A1+A3(U)+A5(U**2)+A7(U**3)+A9(U**4)
	  PIOV2
	JMS I FMPYL	/A1(X)+A3(X**3)+A5(X**5)+A7(X**7)+A9(X**9)
	  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

QDTBL,	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)
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
/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 EXP		/GET SIGN OF 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
SPLITZ,	SPLIT
STICKZ,	STICK
KK10,	10
*SIN+135

/******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
	TAD KK10	/MULT BY 2=2Y
	TAD EXP
	DCA EXP		/(DONE BY ADDING 1 TO EXP.)
	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)
	JMS I SPLITZ	/SPLIT FAC
	TAD NUM
	TAD EXP		/EXP(X)=(2**N)(EXPY)
	DCA EXP
	JMS I STICKZ	/REPACK FAC
	JMP I EXPON	/FAC=EXPON(X)

	NFLAG=EXPON

	*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 EXP		/GET SIGN OF 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 EXP
	SPA SNA		/X<0 OR X=0?
	 JMP I ARTRAP	/YES-TAKE ILLEGAL ARGUMENT TRAP
	TAD M2014	/IS EXP=2014?
	SNA
	TAD HORD	/YES-IS HORD=0?
	SNA
	TAD LORD	/YES-LORD=0?
	SZA CLA
	 JMP POLYNL	/NO-ARG IS LEGAL AND NOT 1
LTRPRT,	DCA EXP	
	JMP I LOG	/YES-LOG(1)=0
POLYNL,	JMS I SPLITS	/SPLIT UP FAC
	TAD EXP		/GET TRUE EXPONENT
	TAD M200
	DCA GTFLG	/SAVE EXPONENT FOR LATER
	TAD KK200
	DCA EXP		/ISOLATE MANTISSA IN FAC
	JMS I STICKS	/REPACK 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
M2014,	-2014
SPLITS,	SPLIT
M200,	-200
KK200,	200
STICKS,	STICK

/CONSTANTS USED BY VARIOUS FUNCTIONS

PIOV2,	2016		/1.57079633
	2207
	7325
SINA3,	6005		/-0.645963711
	1256
	7405
SINA5,	1755		/.079689679
	0632
	1276
SINA7,	5714		/-.00467376557
	6223
	1430
SINA9,	1644		/.00015148419
	7553
	6723
LOG2E,	2015		/1.442695
	6125
	0731
LN2OV2,	1775		/.34657359027
	4271
	0300
EXPB1,	2067		/60.0901907
	4056
	1326
EXPA1,	6124		/-601.804267
	5471
	5711
EXPA0,	2046		/12.01501675
	0036
	6021
ATANB0,	1765		/.174655439
	4554
	3400
ATANA1,	2027		/3.70925626
	3262
	1643
ATANB1,	2036		/6.7621392
	6061
	5620
ATANA2,	6037		/-7.10676005
	0665
	2236
ATANB2,	2026		/3.31633543
	5037
	3266
ATANA3,	5774		/-.264768620
	1707
	7005
ATANB3,	2015		/1.44863154	
	6266
	3017

SQRP5,	2005		/.707106781
	5202
	3630
LOGC1,	2025		/2.88539129
	6125
	1002
LOGC3,	2007		/.961470632
	5421
	3603
ONE,	2014		/1
	0
	0
ONEHAF,	2004		/.5
	0
	0

	FFSIN=SIN
	FFCOS=COS
	FFATN=ATAN
	FFLOG=LOG
	FFEXP=EXPON
PAUSE
/27-BIT FLOATING PT INTERPRETER
/DEC-08-NFPEA-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
*40
AC0,	0
AC1,	0	/HOLDS HIGH ORDER MANT. OF FAC AFTER SPLIT
AC2,	0	/HOLDS HIGH ORDER MANT. OF OPR. AFTER SPLIT
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, 7 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
/
/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
/
/MDSET-SETS UP SIGNS FOR MULTIPLY AND DIVIDE
/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	ARGET	/GET ARGUMENT
	JMS	SPLIT	/SPLIT UP FAC AND OPERAND
	TAD	TM	/ADD SIGN OF FAC AND OP
	TAD	AC0
	DCA	TM	/STORE FINAL SIGN
	DCA	AC0	/MUST BE ZERO FOR DIVIDE
	TAD	OPX	/EXIT WITH OPERAND EXPONENT IN AC
	JMP I	MDSET
CDFCRK,	CDFCUR

/
/ROUTINE TO PACK FAC INTO 3 WORDS AFTER
/NORMALIZATION--ALSO CHECKS FOR EXPONENT OVERFLOW AND 
/UNDERFLOW.
/
STICK,	0
	TAD	ACX	/GET THE FINAL EXPONENT
	SPA		/IS IT NEGATIVE?
	JMP I	NDFLO	/YES-UNDERFLOW-TRAP OUT
	AND	K7400	/NO-IS IT TOO BIG (OVERFLOW)?
	SZA	CLA
	JMP I	OVFLO	/YES-TRAP OUT
	TAD	ACX	/NO-SHIFT IT INTO POSITION
	CLL	RTL
	RAL
	TAD	TM	/ADD SIGN AND HIGH ORDER
	TAD	AC1	/MANTISSA BITS
	DCA	ACX	/STORE IT BACK
DONES,	DCA	SPLTFG	/CLEAR SPLIT FLAG
	DCA I	OVP	/CLEAR OVERFLOW WORD
	CLL
	JMP I	STICK	/RETURN
OVP,	OV
NDFLO,	FTRP4
OVFLO,	FTRP5
K7400,	7400

NDRFLO,	SKP	CLA	/UNDERFLOW-ZERO FAC
OVRFLO,	CLA CLL CMA RAR	/OVERFLOW-SET FAC TO 3777;0;0
	DCA	ACX
	DCA	ACH
	DCA	ACLO
	JMP	DONES	/DONE
/
/ROUTINE TO UNPACK FLOATING AC AND OPERAND
/PUT OPERAND EXPONENT INTO OPX, MANTISSA TO AC2,OPH,OPL
/PUT FA EXP. IN ACX, MANTISSA TO AC1,ACH,ACLO
/OP SIGN TO AC0, FAC SIGN TO TM
/
SPLIT,	0
	TAD	SPLTFG	/IF FLAG SET-THEY'RE ALREADY UNPACKED
	SZA	CLA	/WELL?
	JMP I	SPLIT	/ALREADY DONE-RETN.
	JMS I	CDFCRK	/NOT DONE - CHANGE TO DATA FLD. OF FPP
	CLA CLL CML RAR	/PICK OFF SIGN BIT OF OPERAND
	AND	OPX	/MANTISSA
	DCA	AC0	/STORE FOR LATER
	TAD 	OPX	/PICK OFF HI ORDER MANTISSA BITS
	AND	KP7
	DCA	AC2	/STORE IN AC2
	TAD	OPX	/NOW GET THE EXPONENT OF OP.
	CLL	RTR	
	RAR
	AND	K377	/MASK OFF GARBAGE
	DCA	OPX	/AND STORE
	CLA CLL CML RAR	/NOW FAC-GET SIGN BIT
	AND	ACX
	DCA	TM	/STORE IT
	TAD	ACX	/GET HI MANTISSA BITS OF FAC
	AND	KP7
	DCA	AC1	/STORE AWAY
	TAD	ACX	/NOW GET THE FAC'S EXPONENT
	CLL	RTR
	RAR
	AND	K377
	DCA	ACX	/STORE AWAY
	ISZ	SPLTFG	/SET FLAG-WE'VE UNPACKED FAC, AND OP
	JMP I	SPLIT	/DONE
KP7,	7
K377,	377
SPLTFG,	0

/
/ROUTINE TO ZERO FAC ON DIVIDE BY ZERO
/
DBAD,	DCA	ACLO
	DCA	ACH
	JMP I	DVDD	/GO ZERO REST
DVDD,	DVD
/
/FCDF-BITS 6-8 ARE NEW FLTG. DATA FIELD
/
FFCDF,	TAD	OPH	/GET FIELD BITS (EFF. ADDR.)
	TAD	PCDF0	/ADD IN CDF INSTR.
	JMP I	SFDFP	/GO STORE CDF TO FLTG. D.F.
SFDFP,	SFDF
PCDF0,	6200
*FLPT-1600

/
/FLOATING OUTPUT ROUTINE
/
FFOUT,	0
	DCA	AC1	/CLR. AC1 INCASE FAC=0
	DCA	KNT	/CLEAR COUNT WORD
	TAD	EFLG	/IS THIS E FORMAT?
	SZA	CLA	
	JMP	FFMT	/NO-F FORMAT
	TAD	KK7	/YES-GET A 7
	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	KM10	/SET # OF SIGNF. DIGITS
	DCA I	DCNTP	/TO 7 (DON'T PRINT 8TH)
	TAD	ACX	/GET EXP WORD OF NUMBER
	SMA	CLA	/IS NUMBER NEGATIVE?
	CLL CMA RAL	/NO-MAKE A -2
	TAD	K255	/FORM CORRECT SIGN OF #
	DCA	TEM	/STORE FOR LATER OUTPUT
	CLA CLL CMA RAR	/ZERO SIGN BIT OF #
	AND	ACX	/SO WE DEAL ONLY WITH POS. #S
	SNA		/IS #=0?
	JMP	FOUT	/YES-SKIP DOWN
	DCA	ACX
FOUT1,	CLA CLL CML RTR	/GET # TO RANGE .1<=N<1
	AND	ACX	/IS EXP. NEGATIVE?
	SZA	CLA
	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
	TAD	K2035	/SET FAC TO 5
	DCA	ACX	/(IT WILL GO TO .5 AT FIRST DIV.)
	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 DIGTS AFT. DC. PT.
	SMA		/MUST BE NEGATIVE
	CMA
	TAD	K10	/LIMIT # OF DIVS TO 8
	SPA
KM10,	-10	/=SPA SNA SZL CLA-WON'T SKIP=CLA
	TAD	KM10	/RESTORE
	DCA	SE	/STORE AS COUNTER
	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,	JMS I	SPLITT	/SPLIT UP THE FAC
	DCA I	SPLTFP	/(CLEAR SPLIT FLAG-ELSE BAD NEWS LATER)
	TAD	ACX	/SHIFT MANTISSA ACCORDING TO EXP
	TAD	M201	/0=1 LEFT; 1=NO SHIFT;2=1 RIGHT,...
	DCA	SE	/STORE COUNTER
	JMS I	AL1PT	/SHIFT LEFT
	SKP		/SKIP DOWN
	JMS I	AR1PTR	/SHIFT FAC RIGHT 1 BIT
	ISZ	SE	/DONE?
	JMP	.-2	/NO-GO BACK
FOUT,	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	KM5	/GET MINUS 5-FOR 2 SIGNS,+EXP
	JMP	ADFW	/GO ADD FIELD WIDTH
AR1PTR,	AR1
AL1PT,	AL1
/
/ROUTINE TO GET FAC<1
/
SE,	0
SE1,	TAD	ACX
	TAD	KM2007
	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
KM2007,	-2007
SPLITT,	SPLIT
M201,	-201
KM5,	-5
/CONSTANTS AND POINTERS
OUTP,	OUT
K16,	16
CDFCRB,	CDFCUR
FLINK,	JMP I	FFOUT
PRNTXP,	PRNTX
DCNTP,	DCNT
KK7,	7
K255,	255
K10,	10
FFADP,	FFADD
FFDVP,	FFDIV
FFPUTP,	FFPUT
FFMPP,	FFMPY
K2035,	2035
KNT,	0
SPLTFP,	SPLTFG
/CONTINUATION OF OUTPUT MAINLINE
NOTE,	TAD	KNT	/GET COUNT OF MULTIPLIES
	SMA		/IF NOT NEG-MAKE = -1
	CLA	CMA
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
	SZA		/DID HE SAY NO DEC. PLACES?
	IAC		/NO-ADD 1 FOR  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
	JMS I	OUTP	/PRINT A SPACE
	240
	ISZ	SE	/DONE?
	JMP	.-3	/NO-GO ON
	JMS I	OUTP	/PRINT PROPER SIGN OF NUMBER
TEM,	0
/*************************************
/FALL THROUGH PAGE BOUNDARY!!!
/'TEM,	0' MUST BE LAST LOC. ON PAGE!!!
/(CURSE YOU B.C.)
/*************************************
*FLPT-1400
/*******FALL THROUGH PAGE BOUNDARY TO HERE*******
	TAD I	KNTP	/MUST BE FIRST LOC. OF PAGE!!*********
	SMA
	JMP	PRZRO	/PRINT LEADING ZERO
	CMA	IAC	
	JMS	DGTYP	/OUTPUT 'KNT' DIGITS
PRDCP,	TAD	DADP	/CHECK DADP FOR 0
	SZA	CLA	/DON'T PRINT '.' IF DADP=0
PDP,	JMS	OUT	/PRINT DEC. PT.
	256
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
	DCA	ACX	/ZERO COUNT OF SUBTRACTS FOR DIV.
	TAD	OPX	/GET THE COUNT(DEC. EXP.)
	SPA
	CMA	IAC	/NEGATE IF NEGATIVE
LOOP,	DCA	OPX	/STORE NEW VALUE OF OPX
	TAD	OPX	/GET DEC. EXP. BACK
	TAD	KM12	/SUBTRACT 10 (WE'RE DIVIDING
	SPA		/BY 10)-DID SUBTRACT SUCCEED?
	JMP	.+3	/NOPE-DONE-ACX IS TENS PLACE
	ISZ	ACX	/YUP-BUMP CNTR. (TENS PLACE OF DEC. EXP.)
	JMP	LOOP	/TRY AGAIN
	CLA		/DONE-ACX IS TENS PLACE,OPX-ONES PLACE
	TAD	ACX	/PRINT TEN'S PLACE
	JMS	OUTDG
	TAD	OPX	/PRINT ONE'S PLACE
	JMS	OUTDG
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 I	OVPTR	/STORE COUNT PASSED
DT1,	TAD	AC1
	DCA	AC2
	TAD	ACH	/GET FAC AND STORE FOR LATER
	DCA	OPH
	TAD	ACLO
	DCA	OPL
	JMS I	AL1PP	/SHIFT FAC LEFT 1 = FAC*2
	JMS I	AL1PP	/SHIFT LEFT AGAIN = FAC*4
	JMS I	OADDP	/ADD ORIG FAC = FAC*5
	JMS I	AL1PP	/SHIFT FAC 1 LEFT = FAC*10!!
	TAD	AC1	/MASK OFF HI 4 BITS OF RESULT
	AND	K360
	RTR		/SHIFT INTO PROPER PLACE
	RTR
	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)
	TAD	K17	/REMOVE DIGIT JUST PRINTED FROM FAC
	AND	AC1
	DCA	AC1
	ISZ I	OVPTR	/DONE REQUIRED?(MUST LEAVE OV=0!!)
	JMP	DT1	/NOPE
	JMP I	DGTYP	/YUP
OVPTR,	OV
K17,	17
KM12,	-12
DCNT,	0	/COUNT OF SIGNF. DIGITS
AL1PP,	AL1
OADDP,	OADD
FLING,	FLINK
/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
*FLPT-1220
/
/DO NOT MOVE!!!!
/MUST BE AT LOC.160 ON PAGE!!
/SEE LOC.PRZRO
/
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
TM3,	0
	0
SEP,	0
/
/PRINT A LEADING ZERO
/
PRZRO,	360		/DOES A CLA!!!!
	JMS	OUTDG
	JMP	PRDCP
K360=PRZRO
/
/FLOATING POINT INPUT ROUTINE
/
*FLPT-1200
FFIN,	0
	DCA	SIGNF	/SET SIGN SWITCH TO 0
	JMS I	CDFCRA	/CHANGE TO DF OF PACKAGE
	CLA	CMA
	DCA I	FDVPT	/INITIALIZE PERIOD SWITCH TO -1
	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,	TAD	ACX	/ADD SIGN TO EXPONENT WORD OF FAC
	SZA		/UNLESS,OF COURSE, ITS 0
	TAD	SIGNF	/(SINCE THAT COULD YIELD -0)
	DCA	ACX	/STORE IT BACK
	CLA	CMA
	DCA	SIGNF	/RESET SIGN SWITCH FOR EXP.
	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 POSITIVE?
	CMA	IAC	/NO-NEGATE IT
	CMA	IAC
	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
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,	2170
TP1,	0		
	0
TEN,	2045
	0
	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
/
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.
	CLL	RTR	/NO WAS IT MINUS SIGN?
	SZA	CLA
	JMP	.+4
	CLA CLL CML RAR	/YES-SET SWITCH TO 4000
	DCA	SIGNF	/TO FLIP SIGN
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. T CALL+2
	JMP I	GCHR	/NO-RETN. TO CALL+1
/
/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
K7506,	7506
*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
KM27,	-33
/
/INVERSE FLOATING DIVIDE
/FSWITCH=1
/THIS IS OP/FAC
/
FFDIV1,	0
	SNA		/WHICH MODE OF CALL?
	TAD I	FFDIV1	/CALLED BY USER-GET ADDR.
	DCA	FFSUB1	/STORE IT TEMPORARILY
	TAD	ACX	/NOW STORE THE FAC IN THE OPERAND
	DCA	OPX	/EXPONENT
	TAD	ACH
	DCA	OPH	/HIGH ORDER MANTISSA
	TAD	ACLO	/LOW ORDER MANTISSA
	DCA	OPL
	TAD I	FFSUB1	/NOW PICK UP THE OPERAND AND
	DCA	ACX	/STORE IT IN THE FAC
	ISZ	FFSUB1	/BUMP POINTER DOWN
	TAD I	FFSUB1	/HI MANTISSA
	DCA	ACH
	ISZ	FFSUB1
	TAD I	FFSUB1
	DCA	ACLO
	JMS I	SPLITK	/UNPACK FAC AND OP
	TAD	FFDIV1	/NOW FUDGE THE ADDRESS LINKAGE
	DCA I	FFDP	/('SPLIT' CHANGED TO PROPER D.F.)
	TAD	TM	/DO THE SIGN CALCULATION
	TAD	AC0
	DCA	TM
	DCA	AC0	/MUST BE ZERO FOR DIV. ROUTINE
	TAD	OPX	/JUMP INTO DIVIDE ROUTINE W/OPX IN AC
	JMP I	KFD1	/DO IT
FFDP,	FFDIV
KFD1,	FFD1
ARGETL,	ARGET
AL1K,	AL1
AN1=FFSUB1
AN2=FFDIV1
AN3=OPX
/FLOATING SQUARE ROOT
/USES A HARDWARE TYPE ALGORITHM FOR BINARY SQUARE ROOTS
/REF: THE LOGIC OF COMPUTER ARITHMETIC-IVAN FLORES-P 409
/
FROOT,	0
F7600,	7600		/CLA
	DCA	OPX	/ZERO OPERAND EXP. FOR SPLIT
	JMS I	SPLITK	/SPLIT UP FAC
	CLA CLL CML RTL	/SET FIRST TRIAL BIT-1 BIT TO THE
	RTL		/LEFT OF WHERE IT SHOULD BE
	DCA	AC2	/(IT WILL GET SHIFTED RIGHT)
	DCA	OPH	/ZERO STORAGE FOR TRIAL BIT
	DCA	OPL
	DCA	AN1	/ZERO STORAGE FOR RESULT
	DCA	AN2	/(AN3=OPX IS ALREADY ZERO)
	TAD	AC1	/IS FAC=0?
	SNA	CLA
	JMP	DONE	/YES-RETURN ZERO
	TAD	KM27	/NO-SET UP COUNTER FOR 27 BIT RESLT
	DCA	TM	/WE IGNORE SIGN OF FAC
	TAD	ACX	/GET EXPONENT OF FAC
	CLL	RAR	/DIVIDE IT BY 2
	TAD	K100	/ADD IN 1/2 THE BIAS (SINCE IT WAS
	DCA	ACX	/DIVIDED BY 2 ALSO)
	SZL		/BUMP EXPONENT IF ORIGINAL EXP. 
	ISZ	ACX	/WAS ODD--CAN'T SKIP
	SNL		/DO A PRE-SHIFT FOR EVEN EXPONENTS
SLOOP,	JMS I	AL1K	/SHIFT FAC LEFT 1 BIT
	JMS I	OPSRP	/SHIFT THE TRIAL BIT 1 PLACE RIGHT
LOP01,	TAD	OPL	/ADD THE TRIAL BIT TO THE
	TAD	AN3	/RESULT SO FAR
	CLL CMA IAC	/AND SUBTRACT FROM FAC
	TAD	ACLO
	DCA	TM1	/STORE TEMPORARILY
	CML	RAL	/PROPAGATE CARRY
	TAD	OPH	/DO MIDDLE ORDER
	TAD	AN2
	CMA	IAC
	TAD	ACH
	DCA	AC0	/STORE TEMPORARILY
	CML	RAL	/ROTATE CARRY
	TAD	AC2	/HI ORDER
	TAD	AN1
	CMA	IAC
	TAD	AC1
	SNL		/DID SUBTRACT SUCCEED?
	JMP	GON	/SUBTRACT FAILED-DON' T CHANGE FAC
	SZA		/OK-IS RESULT=0?
	JMP	LOP02	/NO-GO ON
	TAD	AC0	/YES-CHECK MIDDLE AND LO ORDER
	SNA
	TAD	TM1
	SZA	CLA	/IS REMAINDER ALL ZERO?
	JMP	LOP02	/NOT ALL 0-GO ON
	CMA		/ZERO REMAINDER-TERMINATE
	DCA	TM
LOP02,	DCA	AC1	/STORE REVISED FAC
	TAD	AC0
	DCA	ACH
	TAD	TM1
	DCA	ACLO
	TAD	OPL	/SHIFT TRIAL BIT 1 PLACE TO LEFT
	CLL	RAL	/THIS PUTS IT WHERE RESULT BIT SHOULD BE
	TAD	AN3	/AND ADD IT TO RESULT SO FAR
	DCA	AN3	/(ONLY DONE IF SUBTRACT
	TAD	OPH	/SUCCEEDS)
	RAL
	TAD	AN2
	DCA	AN2
	TAD	AC2
	RAL
	TAD	AN1	/ALL DONE
	DCA	AN1
GON,	CLA
	ISZ	TM	/DONE ALL 27 BITS?
	JMP	SLOOP	/NO-GO ON
	TAD	AN1	/YES-STORE RESULT IN FAC
	DCA	AC1
	TAD	AN2
	DCA	ACH
	TAD	AN3
	DCA	ACLO
	JMS I	AR1K	/SHIFT RESULT RIGHT 1 PLACE
DONE,	JMS I	STICKP	/GO PACK RESULT INTO 3 WORDS
	JMP I	FROOT	/DONE-RETURN

AR1K,	AR1
STICKP,	STICK
SPLITK,	SPLIT
OPSRP,	OPSR
TM1,	0
K100,	100
PAUSE
/27-BIT FLOATING PT INTERPRETER
*FLPT-600
/
/FLOATING MULTIPLY
/DOES A 27 BY 27 BIT FLOATING MULTIPLY
/
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
	TAD	KM201	/SUBTRACT THE BIAS (+1) FROM EXP.
	DCA	ACX	/STORE FINAL EXPONENT
	TAD	AC1	/GET HI ORDER MANTISSA
	DCA	TM4	/STORE IN A TEMP.
	TAD	ACH	/SAME FOR REST OF FAC
	DCA	AC0
	TAD	ACLO
	DCA	TM5
	DCA	ACH	/ZERO FAC-RESULT OF MPY WILL
	DCA	ACLO	/BE STORED THERE
	DCA	AC1
	TAD	M27	/SET UP COUNTER FOR 27 BIT MPY
	DCA	OPX
	CLA CLL IAC	/SET UP MASK FOR EXAMINING
LOOPM,	DCA	MSK	/MULTIPLIER BITS
	JMS I	AR1P	/SHIFT RESULT SO FAR RIGHT 1 BIT
	TAD	MSK	/GET THE BIT MASK
	AND	TM5	/MASK MULTIPLIER BIT (FROM LO TO HI)
	SZA	CLA	/IS MULTIPLIER BIT 1?
	JMS I	OADDK	/YES-ADD MULTIPLICAND AND PART. PROD.
	TAD	MSK	/SHIFT THE MASK FOR NEXT BIT
	CLL	RAL
	SZL		/DID WE PASS A WORD BOUNDARY?
	JMP	LP3	/YES-CHANGE MULTIPLIER WORD
LP2,	ISZ	OPX	/ARE WE DONE YET?
	JMP	LOOPM	/NO-GO ON
MDONE,	CLA	CLL	/YES-CLR. AC
	JMS I	FNORK	/NORMALIZE RESLT AND PACK INTO 3 WORDS
	ISZ	FFMPY	/BUMP RETURN ADDRESS
	JMP I	FFMPY	/RETURN

LP3,	TAD	AC0	/DONE A MULTIPLIER WORD-MOVE NEXT ONE
	DCA	TM5	/INTO TM5
	TAD	TM4	/MOVE LAST WORD TO AC0 FOR NEXT
	DCA	AC0	/WORD BOUNDARY CROSSING
	CLL	IAC	/SET UP MASK BIT
	JMP	LP2	/GO BACK
K177,	177
DVBY0P,	FTRP2
K40,	40
OPNEGP,	OPNEG
KM29,	-35
TM4,	0
TM5,	0
KM201,	-201
M27,	-33
FNORK,	FFNOR
MSK,	0
AR1P,	AR1
OADDK,	OADD
MDSETK,	MDSET
/
/SHIFT 3 WD FAC LEFT 1 BIT
/WORDS=AC1,ACH,ACLO
/
AL1,	0
	TAD	ACLO
	CLL	RAL
	DCA	ACLO
	TAD	ACH
	RAL
	DCA	ACH
	TAD	AC1
	RAL
	DCA	AC1
	JMP I	AL1
/
/ROUTINE TO MOVE RESULT BITS WHEN WE HAVE FILLED A WORDSWORTH(PUN!)
/
HLP,	TAD I	OADDK	/GET THE RESULT SO FAR
	DCA I	MDSETK	/STORE SAFELY
	TAD	AC0	/GET THE RESULT BITS JUST GENERATED
	DCA I	OADDK	/AND STORE THEM
	DCA	AC0	/CLEAR AC0
	RAR		/ROTATE RESULT BIT MASK TO AC
	JMP	DGON	/GO ON
/
/END OF FLOATING DIVIDE
/
DVDONE,	TAD	AC0	/YES-GET RESULT AND PUT IN FAC
	DCA	ACLO
	TAD I	OADDK
	DCA	ACH
	TAD I	MDSETK
DVD,	DCA	AC1
	JMS I	FNORK	/NORMALIZE RESULT AND PACK TO 3 WDS
	ISZ	FFDIV	/BUMP RETN. ADDR.
	JMP I	FFDIV	/RETURN

*FLPT-456
/
/FLOATING DIVIDE ROUTINE
/DONE BY MULTIPLE SUBTRACTIONS
/(NOTE: MDSET SETS AC0 TO ZERO)
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
	TAD	K177	/ADD THE BIAS (-1)
	DCA	ACX	/STORE AS FINAL EXPONENT
	TAD	AC2	/CHECK DIVISION BY ZERO
	SNA	CLA
	JMP I	DVBY0P	/YES-GIVE ERROR
	TAD	K40	/NO-SET UP INITIAL BIT MASK
	DCA	MSK	/STORE
	JMS I	OPNEGP	/NEGATE OPERAND FOR SUBTRACTS
	TAD	KM29	/SET COUNTER FOR 29 RESULT BITS
	DCA	TM4	/(SO WE CAN ROUND-FIRST BIT MAY BE 0!)
DVLP,	TAD	MSK	/SHIFT POSITION OF RESULT BIT MASK
	CLL	RAR
	SZL		/DID WE CROSS A WORD BOUNDARY?
	JMP	HLP	/YES-MUST FIX UP SOME STUFF
DGON,	DCA	MSK	/STORE SHIFTED RESULT BIT BACK
	TAD	ACLO	/DO THE TRIAL SUBTRACT OF OPERAND
	TAD	OPL	/FROM FAC(LO ORDER)
	DCA	FFMPY	/STORE TEMPORARILY
	RAL		/PROPAGATE CARRY
	TAD	ACH	/DO THE MIDDLE ORDER
	TAD	OPH
	DCA	OPX	/STORE IN A TEMP.
	RAL		/PROPAGATE CARRY
	TAD	AC1	/DO HIGH ORDER
	TAD	AC2
	SNL		/WAS SUBTRACT SUCCESSFUL?
	JMP	DV2	/NO-DON'T CHANGE FAC
	DCA	AC1	/YES-STORE BACK THE ADJUSTED FAC
	TAD	OPX
	DCA	ACH
	TAD	FFMPY
	DCA	ACLO
DV2,	SZL	CLA	/WAS SUBTRACT SUCCESSFUL?
	TAD	MSK	/YES-PUT A 1 IN RESULT
	TAD	AC0	/AND STORE BACK
	DCA	AC0
	JMS	AL1	/SHIFT FAC LEFT 1 BIT
	ISZ	TM4	/DONE ALL 29 BITS?
	JMP	DVLP	/NO-GO ON
	JMP	DVDONE	/(JMP SO DIV. ROUTINE IS ORG'ED RIGHT)
*FLPT-400
/
/FLOATING ADD
/
FFADD,	0
	SNA		/WHICH MODE OF CALL?
	TAD I	FFADD	/CALLED BY USER-GET ADDR. OF OPR.
	JMS I	ARGETP	/PICK UP OPERAND
FAD1,	JMS I	SPLITP	/SPLIT UP OPERAND AND FAC
	TAD	ACX	/DO EXPONENT CALCULATION
	CLL CMA IAC
	TAD	OPX
	SZL		/WHICH EXP. GREATER?
	JMP	FACR	/OPERANDS-SHIFT FAC RIGHT
	DCA	OADD	/FAC'S-STORE COUNT-SHIFT OP RIGHT
	TAD	AC2	/DON'T SHIFT A ZERO!
	SNA	CLA
	JMP	DOADD	/ZERO-JUST ADD
	JMS	OPSR
	ISZ	OADD	/DONE ALL SHIFTS?
	JMP	.-2	/NO-GO ON
DOADD,	TAD	TM	/YES-ADD THE SIGNS OF FAC AND OP
	TAD	AC0	/AND SEE IF THEY ARE DIFFERENT
	SPA	CLA	/ARE SIGNS DIFFERENT?
	JMS	OPNEG	/YES-NEGATE OPERAND
	JMS	OADD	/DO THE ADDITION
	TAD	AC1	/IS THE RESULT NEG? (I.E. IS OPR
	SMA	CLA	/GREATER IN MAGNITUDE THAN FAC?)
	JMP	DONA	/NO-RESULT WILL KEEP SIGN OF FAC
	TAD	ACLO	/YES-NEGATE RESULT(TO MAKE IT PLUS)
	CLL CMA IAC
	DCA	ACLO
	CML	RAL
	TAD	ACH
	CMA	IAC
	DCA	ACH
	CML	RAL
	TAD	AC1
	CMA 	IAC
	DCA	AC1
	TAD	AC0	/AND GIVE IT THE SIGN OF OPERAND
	DCA	TM
DONA,	DCA	OV	/CLEAR THE OVERFLOW WORD
	JMS I	FNORP	/NORMALIZE RESULT AND PACK INTO 3 WDS
	ISZ	FFADD	/BUMP RETURN
	JMP I	FFADD	/RETURN
FACR,	CMA		/SHIFT FAC-SET UP SHIFT COUNT
	DCA	OADD	/AND STORE
	TAD	OPX	/SET FINAL EXP EQUAL TO EXP OF OP
	DCA	ACX
	TAD	AC1	/DON'T SHIFT A ZERO!
	SNA	CLA
	JMP	DOADD	/ZERO-JUST ADD
	SKP
	JMS 	AR1	/SHIFT FAC 1 PLACE RIGHT
	ISZ	OADD	/DONE ALL?
	JMP	.-2	/NO-GO ON
	JMP	DOADD	/YES-DO THE ADD
/
/ROUTINE TO SHIFT 3 WORD OPERAND IN AC2,OPH,OPL
/1 BIT TO THE RIGHT
/
OPSR,	0
	TAD	AC2
	CLL	RAR
	DCA	AC2
	TAD	OPH
	RAR
	DCA	OPH
	TAD	OPL
	RAR
	DCA	OPL
	JMP I	OPSR
/
/ROUTINE TO SHIFT 3 WORD FAC 1 BIT  TO THE
/RIGHT (FAC IS IN AC1,ACH,ACLO)
/KEEP 1 BIT OF OVERFLOW IN OV FOR POSSIBLE ROUND
/
AR1,	0	
	TAD	AC1
	CLL	RAR
	DCA	AC1
	TAD	ACH
	RAR
	DCA	ACH
	TAD	ACLO
	RAR
	DCA	ACLO
	RAR
	DCA	OV
	JMP I	AR1
*FLPT-261
/
/FLOATING SUBTRACT
/
FFSUB,	0
	SNA		/WHICH MODE OF CALL?
	TAD I	FFSUB	/CALLED BY USER-GET ADDR. OF OP
	JMS I	ARGETP	/PICK UP THE OP.
	CLA CLL CML RAR	/SWITCH SIGN OF OPERAND
	TAD	OPX
	DCA	OPX
	TAD	FFSUB	/JMP INTO FLTG. ADD
SUB0,	DCA	FFADD	/AFTER SETTING UP RETURN
	JMP	FAD1
OV,	0
ARGETP,	ARGET
SPLITP,	SPLIT
FNORP,	FFNOR
/
/FLOATING NEGATE
/UED IF FAC HAS NOT BEEN SPLIT UP!
/
FFNEG,	0		/(USED AS A TEM. BY OUTPUT ROUTINE)
	CLA CLL CML RAR	/GET A 4000 INTO AC
	TAD	ACX	/SWITCH THE SIGN BIT OF THE FAC
	DCA	ACX	/STORE BACK
	CLL		/AC=L=0 ON RETN
	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
	CMA	IAC		/NEGATE AND STORE BACK
	DCA	OPH
	CML	RAL
	TAD	AC2	/GET VERY HI ORDER
	CMA	IAC	/NEGATE
	DCA	AC2	/STORE BACK
	JMP I	OPNEG

/
/ROUTINE TO ADD 3 WORD OPERAND (AC2,OPH,OPL)
/TO 3 WORD FAC (AC1,ACH,ACLO) AND STORE RESULT
/IN FAC
/
OADD,	0
	CLL
	TAD	OPL	/ADD THE LOW ORDERS
	TAD	ACLO
	DCA	ACLO	/STORE IN LOW ORDER FAC
	RAL		/ROTATE CARRY TO AC
	TAD	OPH	/ADD MIDDLE ORDERS
	TAD	ACH
	DCA	ACH	/STORE IN FAC
	RAL		/ROTATE CARRY
	TAD	AC2	/ADD HI ORDERS
	TAD	AC1
	DCA	AC1
	JMP I	OADD	/DONE
*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.
SPLITB,	SPLIT
K7770,	7770
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
/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,	2267
	5252
STICKA,	STICK
/
/ROUTINE TO NORMALIZE THE FAC
/AND THEN PACK IT INTO 3 WORDS 
*FLPT-113
FFNOR,	0
	JMS I	SPLITB	/SPLIT UP FAC IN CASE NOT SPLIT YET
FN0,	TAD	AC1	/SHOULD FAC BE SHIFTED RIGHT?
	TAD	K7770
	SPA	CLA
	JMP	FN1	/NO-SEE IF WE SHOULD ROUND UP
	JMS I	AR1PT	/YES-SHIFT RIGHT
	ISZ	ACX	/INCREMENT EXPONENT
	NOP
	JMP	FN0	/GO CHECK AGAIN
FN1,	TAD I	OVPT	/GET OVERFLOW WD-SEE IF WE ROUND
	SNA	CLA
	JMP	FN3	/NO ROUND OFF-GO ON
	ISZ	ACLO	/YES-INCREMENT LOW ORDER
	JMP	FN3	/NO-CARRY-DONE ROUNDING
	JMP	FN4	/JMP AROUND GET, PUT
OVPT,	OV
/
/FLOATING GET
/
FFGET,	0
	SNA		/WHICH MODE OF CALL
	TAD I	FFGET	/CALLED BY USER-GET ADDR. OF OP
	JMS I	ARGETK	/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
/
/CONTINUATION OF NORMALIZE ROUTINE
/
FN4,	ISZ	ACH	/CARRY-INCREMENT MIDDLE ORDER
	JMP	FN3	/NO FURTHER CARRY-DONE
	ISZ	AC1	/CARRY OUT OF MIDDLE-BUMP HIGH ORDER
	DCA I	OVPT	/ZERO OVERFLOW WD
	JMP	FN0	/GO CHECK IF NORMALIZED
FN2,	JMS I	AL1P	/SHIFT FAC LEFT 1
	CLA	CMA	/SUBTRACT 1 FROM EXPONENT
	TAD	ACX
	DCA	ACX
FN3,	TAD	AC1	/CHECK I FAC=0
	SNA
	TAD	ACH	/HI ORDER
	SNA
	TAD	ACLO
	SNA	CLA	/IS WHOLE FAC=0?
	JMP	ZEXP	/YES-ZERO EXPONENT
	CLA CLL CMA RTL	/NO-INSURE THAT # IS NORMALIZED
	TAD	AC1	/(I.E. HI ORDER DIGIT IS 4,5,6,OR 7)
	SPA SNA CLA	/IS IT?
	JMP	FN2	/NO-SHIFT FAC LEFT AND DECREMENT EXP
NDON,	JMS I	STICKA	/YES-CHECK FOR ERRORS AND PACK FAC
	JMP I	FFNOR	/DONE-RETURN
AR1PT,	AR1
ZEXP,	DCA	ACX
	DCA	TM	/ZERO SIGN
	JMP	NDON	/GO PACK FAC
ARGETK,	ARGET
/
/FLOATING HALT-DISPLAY FLOATING P.C.
/
FFHLT,	JMS	CDFCUR	/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.
/
/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	P177	/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 LATER
	TAD	OPH	/GET ADDRESS INTO AC
	SNL		/INDIRECT BIT IN LINK-IS IT ON?
	JMP	DCOD	/NO-CALL THE PROPER ROUTINE
	AND	P7770	/YES-IS ADDR AN AUTO INDEX REG.?
	TAD	P7770
	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.-INDIRECT 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
/
P177,	177
FCALLP,	FCALL
KCDF0,	CDF	0
P7770,	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-SZ 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	ACX	/GET EXP OF FAC TO AC 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

FFSQC,	JMS I	TMPY	/CALL MULTIPLY TO MULTIPLY
	ACX		/FAC BY ITSELF
	JMP I	FFSQ	/DONE
*FPT+164
/
/FSQUARE-SQUARE FAC-CALLS MULTIPLY TO MUL. FAC BY ITSELF
/
FFSQ,	0
	JMP	FFSQC	/JUMP TO LEAVE ROOM 4 EXTRA TRAPS
/
/FLOATING TRAPS TO USER-INITIALLY SET TO NOPS
/
FTRP4,	JMP I	FTRAP4	/EXP. UNDERFLOW
FTRP5,	JMP I	FTRAP5	/EXP. OVERFLOW
FTRP1,	JMP I	FTRAP1	/FIX OVERFLOW
FTRP2,	JMP I	FTRAP2	/DIV. ERR.
FTRP3,	JMP I	FTRAP3	/ILL. FUNCT. ARG.
FTRAP5,	OVRFLO
FTRAP1,	FTRPRT
FTRAP2,	DBAD
FTRAP3,	LTRPRT
FTRAP4,	NDRFLO
$