/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