/***** FLOAT -- FOR FOCAL 5/69 *****
/E.A.TAFT  25-JUL-72
*5600
/DECIMAL TO BINARY CONVERSION 2/10/69
DBCONV,	0
	FLOAT		/FLOAT A ZERO
	DCA DECEXP	/INITIALIZE
	CMA
	DCA PSWIT
	TAD C43	/35(10)
	DCA FLAC0
	JMS I SGNTST	/SIGN OF MANTISSA
	DCA INSIGN
	JMP NEWDIG+1
PERIOD,	ISZ PSWIT	/. FOUND, SEE IF FIRST
	ERROR		/DOUBLE PERIODS
NEWDIG,	GETC		/LOOK FOR A DIGIT
	TESTN
	JMP PERIOD	/. FOUND
	JMP NOTDIG	/NOT FOUND
	TAD PSWIT	/DECREMENT DECIMAL EXPONENT
	SMA CLA		/IF AFTER .
	CMA
	TAD DECEXP
	DCA DECEXP
	JMS MULT10	/MULTIPLY FLAC BY 10
	TAD SORTCN	/ADD NEW DIGIT
	DCA FLOP3
	DCA FLOP2
	DCA FLOP1
	JMS TRPLAD
OVCHEK,	TAD REMAIN	/CHECK FOR OVERFLOW
	SZA CLA
	JMP .+4
	TAD FLAC1
	SMA CLA
	JMP NEWDIG	/NO OVERFLOW
	TAD IOVRL	/OVERFLOW, ROTATE RIGHT
	DCA I IRARAC	/SET UP RETURN TO OVCHEK
	TAD REMAIN	/ROTATE REMAIN
	CLL RAR
	DCA REMAIN
	TAD FLAC1
	JMP I ROTRAC	/ROTATE REST OF FLAC

NOTDIG,	SORTC		/TEST FOR LETTER E
	 C305-1
	JMP EINPUT	/FOUND E
DBTERM,	ISZ INSIGN	/END OF INPUT, AFFIX SIGN
	NEGATE
	TAD CFNR	/SET UP TO NORMALIZE
DBLOOP,	DCA .+2
	FENT
PSWIT,	FNR		/OR FMY BY 10 OR .10
	FPT I PT1	/SAVE RESULT
	FEXT
	TAD DECEXP	/CHECK DECIMAL EXPONENT
	SNA
	JMP I DBCONV	/DONE
	SMA
	JMP .+4
	IAC		/NEGATIVE, SET UP TO FMY BY .10
	DCA DECEXP
	JMP .+5
	CLA CMA		/POSITIVE, SET UP TO FMY BY 10
	TAD DECEXP
	DCA DECEXP
	TAD M3
	TAD FLINST	/INSTRUCTION FMY FLTEN OR FLPTEN
	JMP DBLOOP
EINPUT,	GETC		/FOUND "E"
	JMS I SGNTST	/TEST FOR SIGN
	DCA FLOP0
	JMS I DECIN1	/INPUT A DECIMAL INTEGER
	TAD DECNUM
	ISZ FLOP0	/CHECK SIGN
	CIA
	TAD DECEXP
	DCA DECEXP
	JMP DBTERM
/ADD FLOP TO FLAC TRIPLE PRECISION WITH OVERFLOW
TRPLAD,	0
	CLA CLL
	TAD FLOP3
	TAD FLAC3
	DCA FLAC3
	RAL
	TAD FLOP2
	TAD FLAC2
	DCA FLAC2
	RAL
	TAD FLOP1
	TAD FLAC1
	DCA FLAC1
	RAL
	TAD REMAIN
	DCA REMAIN
	JMP I TRPLAD
/MULTIPLY FLAC BY 2
MULT2,	0
	JMS I MULT2I
	TAD REMAIN
	RAL
	DCA REMAIN
	JMP I MULT2
/MULTIPLY FLAC BY 10
MULT10,	0
	PUSHF		/FLAC=>FLOP
	 FLAC1
	POPF
	 FLOP1
	DCA REMAIN	/CLEAR OVERFLOW
	JMS MULT2	/FLAC*10 = (FLAC*2*2+FLAC)*2
	JMS MULT2
	JMS TRPLAD
	JMS MULT2
	JMP I MULT10
SGNTST,	TSTSGN
MULT2I,	RALAC
DECIN1,	DECINT
IRARAC,	RARAC
IOVRL,	OVCHEK
ROTRAC,	RARAC+5
C43,	43
DECEXP,	0	/IMPLICIT DECIMAL EXPONENT
INSIGN,	0	/SIGN OF MANTISSA
CFNR,	FNR
FLINST,	FMY .+4
FLTEN,	0004	/10(10) FLOATING
	2400
	0000
FLPTEN,	7775	/.10(10) FLOATING
	3146
	3147
REMAIN=TEMP1
/CHARACTER LIST FOR "ASK"
ASKLST,	215	/CR
	214	/FF
	337	/BA
	254	/COMMA
USERT,	0	/USER-SELECTED CHARACTER
	212	/LF
/POWER OF 10 TABLE
INTABL,	-1750	/1000
	-144	/100
	-12	/10
	-1	/1
/INPUT A DECIMAL INTEGER <2048
DECINT,	0
	DCA DECNUM
	TESTN		/GET A DIGIT
	NOP
	JMP I DECINT	/NONE FOUND
	GETC
	TAD DECNUM	/MULTIPLY PREV. # BY 10
	CLL RTL
	SPA SZL
	JMP .+5		/OVERFLOW (>2047)
	TAD DECNUM
	RAL
	TAD SORTCN	/ADD NEW DIGIT
	SPA SZL
	ERROR
	JMP DECINT+1
DECNUM=TEMP3
/TEST FOR A SIGN
TSTSGN,	0
	SPNOR
	DCA SORTCN
	SORTC		/LOOK FOR + OR -
	 SNLIST-1
	GETC		/SIGN FOUND
	SPNOR		/NOT FOUND
	CLA CMA
	TAD SORTCN	/SORTCN: 0=+, 1=-
	JMP I TSTSGN	/AC: 7777=+, 0=-
DIGIT=TEMP2
/PRINT A 2-4 DIGIT UNSIGNED DECIMAL INTEGER
/FIRST 2 LEADING ZEROES NOT PRINTED
INTOUT,	0
	DCA DECNUM
	TAD INTPTR	/POWER OF 10 POINTER
	DCA INTSUB
	DCA DECINT	/DECINT=0 MEANS SKIP 0 OUTPUT
	JMS INTDO	/1ST DIGIT (1000S)
	JMS INTDO	/2ND DIGIT (100S)
	ISZ DECINT	/DECINT>0 MEANS PRINT 0S
	JMS INTDO	/3RD DIGIT (10S)
	JMS INTDO	/4TH DIGIT (UNITS)
	JMP I INTOUT
INTDO,	0
	DCA DIGIT	/INITIALIZE
	TAD DECNUM
INTSUB,	TAD INTABL	/SUBTRACT A POWER OF 10
	SPA
	JMP INTNEG
	DCA DECNUM	/POSITIVE RESULT
	ISZ DIGIT	/NONZERO DIGIT, SO IGNORE NO
	ISZ DECINT	/FURTHER ZEROES
	JMP INTSUB-1
INTNEG,	CLA CLL		/NEGATIVE RESULT
	ISZ INTSUB	/SET UP NEXT POWER OF 10
	TAD DECINT	/IS IT A LEADING 0?
	SNA CLA
	JMP I INTDO	/YES, SKIP IT
	TAD DIGIT	/NO, PRINT DIGIT
	TAD C260
	PRINTC
	JMP I INTDO
/OUTPUT A SIGNED INTEGER IN AC
SIGOUT,	0
	DCA DECNUM	/SAVE NUMBER
	TAD DECNUM
	SPA CLA
	TAD P2		/MAKE A -
	TAD C253	/MAKE A +
	PRINTC
	TAD DECNUM	/OUTPUT ABSOLUTE VALUE
	SPA
	CIA
	JMS INTOUT	/OUTPUT THE NUMBER
	JMP I SIGOUT
INTPTR,	TAD INTABL
SNLIST=.	/FOR SIGN TESTING
C253,	253	/+
	255	/-
/E FORMAT OUTPUT ROUTINE
XXX,	CLA		/CONVERT TO E FORMAT ON OVERFLOW
	TAD TOTDIG
	SKP
FLOUT,	TAD DECP	/E FORMAT (%0) FLOATING OUTPUT
	CIA
	SNA
	TAD MDIG	/6 DIGITS IF 0 GIVEN
	DCA DECNUM	/DIGIT COUNTER
	TAD PER		/PERIOD
	PRINTC
FLDIG,	TAD I XRT2	/NEXT DIGIT
	ISZ T2		/OUT OF SIG DIGITS?
	JMP .+3		/NO, PRINT DIGIT
	CLA CMA		/YES, RESET POINTER AND PRINT 0
	DCA T2
	JMS I OUTP
	SKP		/FIELD NOW FILLED, PRINT EXPONENT
	JMP FLDIG
/B-D CONV EXPONENT OUTPUT
	TAD C305	/PRINT LETTER E
	PRINTC
	TAD T1		/OUTPUT THE EXPONENT
	JMS SIGOUT
BDEND,	JMP I BDCONV	/DONE
C305,	305		/E
MDIG,	-DIGITS
OUTP,	OUTA
/PRINT A LINE NUMBER - "PRNTLN"
XPRNTL,	0
	TAD LINENO
	RTL6
	AND P77
	JMS INTOUT	/2-DIGIT PART NUMBER
	TAD PER
	PRINTC		/DECIMAL POINT
	TAD LINENO
	AND P177	/2-DIGIT STEP NUMBER
	JMS INTOUT
	TAD C240	/SPACE
	DCA CHAR
	PRINTC
	JMP I XPRNTL

NEGSGN,	255-240
/BINARY TO DECIMAL CONVERSION AND OUTPUT
BDCONV,	0
	TAD FLAC1	/CHECK SIGN
	SMA CLA
	JMP .+3
	NEGATE		/NEGATIVE, TAKE ABSOLUTE VALUE
	TAD NEGSGN	/MAKE A -
	TAD C240	/MAKE A SPACE
	PRINTC
	CLA CMA		/DECREMENT BINARY EXPONENT
	TAD FLAC0
	DCA FLAC0
BDSCAL,	DCA T1		/INITIALIZE DECIMAL EXPONENT
	TAD FLAC0	/START SCALING: -4<EXP<0?
	SMA
	JMP SDOWN	/TOO BIG, SCALE DOWN
	TAD I TENPT
	SMA CLA
	JMP SCALED	/WITHIN LIMITS, DONE
	FENT		/TOO SMALL, SCALE UP
	FMY I TENPT
	FEXT
	CLA CMA
	TAD T1		/DECREMENT DECIMAL EXPONENT
	JMP BDSCAL
SDOWN,	FENT		/SCALE DOWN
	FMY I PTENPT
	FEXT
	IAC		/INCREMENT DECIMAL EXPONENT
	JMP .-6
/CONSTANTS
DCOUNT,	-DIGITS-1
MDIGIT,	-DIGITS
RND2,	DIGITS+1
M12,	-12
/POINTERS
TENPT,	FLTEN
PTENPT,	FLPTEN
MULT2P,	MULT2
MUL10P,	MULT10
BUFST,	DIGBUF-1
FLOUTP,	FLOUT
XXXP,	XXX
/ROUTINE TO DECREMENT THE DIGIT POINTER
DECR,	CMA
	TAD FLOP0
	DCA FLOP0
	JMP RET
/FINISHED SCALING, GENERATE DIGITS
SCALED,	JMS I MULT2P	/ROTATE FLAC LEFT
	TAD BUFST	/INITIALIZE DIGIT BUFFER
	DCA XRT2
	JMS I MUL10P	/MULTIPLY BY 10
	TAD REMAIN	/OVERFLOW
	JMP BDC1
BDC0,	CLL RAR
	DCA FNEGSW	/TEMP STORAGE OF FIRST DIGIT
	TAD FLAC1	/ROTATE FLAC RIGHT
	RAR
	DCA FLAC1
	TAD FLAC2
	RAR
	DCA FLAC2
	TAD FLAC3
	RAR
	DCA FLAC3
	TAD FNEGSW	/PREV. OVERFLOW
BDC1,	ISZ FLAC0	/CHECK ROTATE COUNT
	JMP BDC0
	SZA
	JMP BDC2
	CLA CMA		/FIRST DIGIT IS 0, IGNORE
	TAD T1		/DECREMENT DECIMAL EXPONENT
	DCA T1
	TAD FLAC1
	SNA CLA
	DCA T1		/EXP=0 IF MANTISSA=0
	SKP
BDC2,	DCA I XRT2	/FIRST DIGIT WAS NOT 0
	TAD DCOUNT	/SET TO COUNT DIGITS
	DCA FLAC0
	JMS I MUL10P	/MULTIPLY BY 10
	TAD REMAIN
	DCA I XRT2	/SAVE DIGIT JUST GENERATED
	ISZ FLAC0
	JMP .-4
	TAD BUFST	/REINITIALIZE POINTER
	DCA XRT2
	TAD DCOUNT	/DIGITS AVAILABLE
	DCA T2
	TAD TOTDIG	/DIGITS WANTED
	SNA
	JMP R6		/E FORMAT, ROUND TO 6 PLACES
	CIA		/COMPUTE FIELD SIZES
	TAD DECP
	SPA SNA
	JMP .+4		/COMPARE DECP TO TOTDIG
	CLA		/MORE DECP THAN TOTAL DIGITS!
	TAD TOTDIG
	DCA DECP
	TAD T1		/COMPARE EXPONENT TO FIELD SIZE
	SMA
	CLA		/INTEGER FIELD >= EXPONENT
	TAD TOTDIG
	SPA
	JMP FPRNT-2	/NO ROUNDING NEEDED
	TAD MDIGIT	/ROUND TO DECP+EXP PLACES
	SMA
	CLA
R6,	TAD RND2	/START ROUNDING
	DCA FNEGSW	/PLACES TO ROUND TO
	TAD BUFST	/ROUNDING START ADDRESS
	TAD FNEGSW	/SET UP ROUND COUNT
	DCA FLOP0
	TAD FNEGSW
	CIA
	DCA FNEGSW	/START ROUNDING PROCESS BY
	TAD I TENPT	/ADDING 4 TO FIRST DIGIT
RET,	ISZ I FLOP0	/INCREMENT CURRENT DIGIT
	TAD I FLOP0
	TAD M12
	SPA CLA		/DIGIT>9?
	JMP FPRNT	/NO, END ROUNDING
	DCA I FLOP0	/YES, SET DIGIT TO 0 AND CARRY
	ISZ FNEGSW	/BEGINNING OF BUFFER?
	JMP DECR	/NO DECREMENT BUFFER ADDRESS
	ISZ I FLOP0	/YES, FAKE CARRY FROM FIRST DIGIT
	ISZ T1
	CLA

FPRNT,	TAD TOTDIG	/SET UP FIELD SIZES
	SNA
	JMP I FLOUTP	/E FORMAT OUTPUT
	CIA
	DCA DECNUM	/NUMBER OF PLACES TO PRINT
	TAD DECNUM
	TAD T1
	SMA SZA
	JMP I XXXP	/TOO BIG, PRINT E FORMAT
	TAD DECP	/OK, TEST DECIMAL PLACES
	SMA
	CLA		/ADJUST DECIMAL POINT
	CIA
	TAD T1
	CLL CIA
	DCA FNEGSW	/NUMBER OF INTEGER PLACES
	SZL
	JMP IN+4	/NO INTEGER PLACES
/START PRINTING
BACK,	TAD T1
	TAD FNEGSW
	SNA CLA
	JMP DIG		/PRINT A DIGIT
	TAD FNEGSW
	IAC
	SPA CLA		/PRINT 0 IF ONE INTEGER PLACE LEFT
	TAD M20		/OTHERWISE A SPACE
IN,	JMS OUTA	/PRINT A CHARACTER
	JMP I BDENDP	/FIELD FILLED, EXIT
	ISZ FNEGSW
	JMP BACK	/CONTINUE
	TAD PER		/DECIMAL POINT
	PRINTC
	JMP BACK
DIG,	CMA
	TAD T1		/DECREMENT DECIMAL EXPONENT
	DCA T1
	ISZ T2		/CHECK SIG DIGIT COUNT
	JMP .+4		/SOME LEFT
	CMA		/ALL USED UP
	DCA T2
	JMP IN		/PRINT A 0
	TAD I XRT2	/PRINT A SIG DIGIT
	JMP IN
/DIGIT PRINT ROUTINE FOR BDCONV
OUTA,	0
	TAD C260	/CONVERT TO ASCII
	PRINTC
	ISZ DECNUM	/FIELD FILLED?
	ISZ OUTA	/NO, GO TO SECOND RETURN
	JMP I OUTA
BDENDP,	BDEND
/ "OPTION" PROCESSOR
OPTION,	SPNOR		/GET OPTION LETTER
	SORTJ
		OPTLST-1
		OPTTBL-OPTLST
	ERROR		/ILLEGAL OPTION NAME
/////
OPTR,	CLA CMA		/SWAP INPUT TO HIGH SPEED READER
	DCA HINBUF
	RFC		/START READER
	TAD RESTR	/POINT TO "HREAD"
OPTK,	TAD PTCH	/SWAP TO KEYBOARD IF CALLED HERE
	DCA 113
/////
OPTRET,	TSTERM		/MOVE TO ,;CR
	JMP .-1
	JMP I .+2	/END OF OPTIONS
	JMP OPTION	/CONTINUE PROCESSING OPTIONS
		PROC
/////
/HIGH SPEED INPUT ROUTINE
HREAD,	0
	CLA CLL
	NOP	/PLACE KEEPERS FOR COMPATIBILITY
	NOP	/WITH THE OLD HREAD ROUTINE
HREAD2,	ION		/(SWAP) - FOR 2-USER
	TAD HINBUF	/WAIT FOR INPUT
	SMA
	JMP	.+3
	CLA
	JMP HREAD2
	SZA	/SWAPS BACK TO ADDS INPUT ON TRAILER CODE
	JMP	HSGO	/ LEGIT CHAR 
	TAD PTCH	/ALL DONE READING TAPE
	DCA 113		/SWAP TO KEYBOARD INPUT
	TAD P337	/RETURN A B.A. TO KILL UNENDED LINE OR GARBAGE
			/CHARACTER
HSGO,	DCA	CHAR	/FOUND CHAR
	CMA
	DCA HINBUF	/SET TO READ NEXT
	TAD	CHAR
	AND P177	/IGNORE PARITY AND BLANK
	SNA
	JMP HREAD+1
	TAD C200
	DCA CHAR
	JMP I HREAD
/////
RESTR,	HREAD-CHIN

PAGE
/FLOATING POINT PACKAGE
/ARITHMETIC INTERPRETER
FPNT,	0
	CLA CLL
	TAD I FPNT	/FLOATING INSTRUCTION
	SNA
	JMP I FPNT	/FEXT
	AND C200	/GET PAGE BIT
	SZA CLA
	TAD FPNT	/CURRENT PAGE
	AND P7600
	DCA FLADDR	/START ADDRESS OF ADDRESSED PAGE
	TAD I FPNT	/GET ADDRESS BITS
	AND P177
	TAD FLADDR
	DCA FLADDR	/FULL 12-BIT ADDRESS
	TAD I FPNT
	ISZ FPNT
	CLL RTL		/OP BITS =>AC9-11
	RTL		/INDIRECT BIT =>LINK
	AND P17
	TAD DRECTR	/SET UP OP POINTER
	DCA DIRECT
	TAD I FLADDR	/INDIRECT?
	SZL
	DCA FLADDR	/YES
	PUSHF		/NO, GET OPERAND
FLADDR,	 0
	POPF
	 FLOP
	DCA FLOP3	/CLEAR LOW ORDER OPERAND
DIRECT,	JMP I .+2	/OP DIRECT INSTRUCTION
DRECTR,	JMP I .+1	/OP TABLE
	FLPOW
	FLADD
	FLSUB
	FLMUL
	FLDIV
	FLGET
	FLPUT
	FLNOR

FLGET,	PUSHF		/OP 5: GET FLAC FROM STORAGE
	 FLOP
	TAD .+3		/SET UP POINTER TO FLAC
	JMP .+4
FLPUT,	PUSHF		/OP 6: PUT FLAC IN STORAGE
	 FLAC
	TAD FLADDR	/SET UP POINTER TO STORAGE
	DCA .+2
	POPF
	 0		/ADDRESS OF STORAGE LOCATION
	JMP FPNT+1
NEGOP,	0		/ROUTINE TO NEGATE FLOP
	TAD FLOP2
	CLL CIA
	DCA FLOP2
	CML RAL
	TAD FLOP1
	CIA
	DCA FLOP1
	TAD FNEGSW	/FNEGSW IS COMPLEMENTED WHEN
	CLL CMA		/FLOP OR FLAC IS NEGATED
	DCA FNEGSW
	JMP I NEGOP
NEGAC,	0		/ROUTINE TO NEGATE FLAC - "NEGATE"
	CLA CLL		/TRIPLE PRECISION
	TAD FLAC3
	CIA
	DCA FLAC3
	CML RAL
	TAD FLAC2
	CIA
	DCA FLAC2
	CML RAL
	TAD FLAC1
	CIA
	DCA FLAC1
	TAD FNEGSW
	CLL CMA
	DCA FNEGSW
	JMP I NEGAC
/ARITHMETIC OPERATIONS
/BOTH FLAC AND FLOP MUST BE NORMALIZED FOR
/+-*/^ (FAD,FSU,FMY,FDV,FXP)
FLSUB,	JMS NEGOP	/OP 2: SUBTRACT OP (NEGATE AND ADD)
FLADD,	TAD FLAC1	/OP 1: ADD OP
	SNA CLA
	JMP FLGET	/RESULT=OPERAND IF FLAC=0
	TAD FLOP1
	SNA CLA
	JMP FPNT+1	/RESULT=FLAC IF FLOP=0
	TAD FLOP0	/COMPARE EXPONENTS
	CIA
	TAD FLAC0
	SNA
	JMP CMBINE	/EQUAL, GO ADD TOGETHER
	SMA		/NOT EQUAL, NEED SHIFTING
	JMP SHFLOP	/FLAC>FLOP, SHIFT FLOP
	TAD P27		/FLAC<FLOP, SHIFT FLAC
	SPA
	JMP FLGET	/TOO FAR TO SHIFT, TREAT AS IF FLAC=0
	TAD M27
	DCA DIRECT	/NUMBER OF PLACES TO SHIFT
	JMS I RARAC1	/SHIFT FLAC 1 TO RIGHT
	ISZ DIRECT
	JMP .-2
	JMP CMBINE	/NUMBERS NOW ALIGNED
SHFLOP,	CIA		/ROUTINE TO SHIFT FLOP
	TAD P27
	SPA
	JMP FPNT+1	/FLOP TOO SMALL, TREAT AS 0
	TAD M27
	DCA DIRECT
	JMS I RAROP1	/SHIFT FLOP 1 TO RIGHT
	ISZ DIRECT
	JMP .-2
CMBINE,	JMS I RARAC1	/NOW SHIFT BOTH TO PREVENT OVERFLOW
	JMS I RAROP1
	JMS I FLAD3	/ADD TRIPLE PRECISION
FLNOR,	JMS I NORF	/OP 7: NORMALIZE FLAC
	JMP FPNT+1
M27,	-27
P27,	27
RAROP1,	RAROP
RARAC1,	RARAC
FLAD3,	TRPLAD
NORF,	FNORM
/DIRECTORY FOR INTERPRETIVE INPUT
ASKLS2,	INTERM	/CR, TERMINATOR
	INTERM	/FF, TERMINATOR
	INBARR	/BA, RESTART INPUT
	INTERM	/COMMA, TERMINATOR
	INTERM	/USER-SPECIFIED TERMINATOR
	INGT	/LF, IGNORE

MULPLR=.
FNORM,	0		/ROUTINE TO NORMALIZE FLAC
	CLL CLA CMA	/INITIALIZE SIGN SWITCH
	DCA FNEGSW
	TAD FLAC1	/TEST FOR ZERO
	SNA
	TAD FLAC2
	SNA
	TAD FLAC3
	SNA CLA
	JMP NOREND	/ZERO, NO NEED TO NORMALIZE
	TAD FLAC1
	SPA CLA
	NEGATE		/SIGN IS NEGATIVE
	DCA NORC	/SHIFT COUNTER
NRLOOP,	TAD FLAC1	/SHIFT NEEDED?
	CLL RAL
	SPA CLA
	JMP NMEXIT	/NO, BIT 1=1
	JMS RALAC
	ISZ NORC	/RECORD A SHIFT
	JMP NRLOOP
NMEXIT,	ISZ FNEGSW	/RESTORE SIGN
	NEGATE
	TAD NORC	/CORRECT EXPONENT
	CIA
	TAD FLAC0
NOREND,	DCA FLAC0
	DCA FLAC3	/NORMALIZED # IS 3 WORDS
	JMP I FNORM
FLTPT,	FPNT+1
NEGOP1,	NEGOP
PROD1=.
RALAC,	0		/ROUTINE TO ROTATE FLAC 1 TO LEFT
	TAD FLAC3
	CLL RAL
	DCA FLAC3
	JMS DRAL	/CALL DOUBLE RAL
	JMP I RALAC
DRAL,	0		/ROTATE FLAC 1 LEFT, DOUBLE PRECISION
	TAD FLAC2
	RAL
	DCA FLAC2
	TAD FLAC1
	RAL
	DCA FLAC1
	JMP I DRAL
NORC=.
/ROUTINE TO TEST SIGNS OF FLAC AND FLOP,
/PLACE FLAC IN TEMP, FOR FLMUL AND FLDIV
FIXSGN,	0
	CLL CLA CMA
	DCA FNEGSW
	TAD FLAC1	/TEST FLAC
	SNA
	JMP I FLTPT	/ZERO, NO OPERATION NEEDED
SPACLA,	SPA CLA
	NEGATE		/TAKE ABS VAL OF FLAC
	TAD FLAC1	/TRANSFER TO TEMP
	DCA TEMP1
	TAD FLAC2
	DCA TEMP2
	TAD FLOP1
SGNSWT,	SPA CLA		/SPA CLA FOR *, SMA CLA FOR /
	JMS I NEGOP1	/TAKE ABS VAL OF FLOP
	TAD FNEGSW
	DCA T2		/STORE SIGN OF RESULT
	JMP I FIXSGN

FLMUL,	TAD SPACLA	/OP 3: MULTIPLY BY OPERAND
	DCA SGNSWT	/WANT POSITIVE OPERAND HERE
	JMS FIXSGN
	TAD FLOP2
	JMS SDMULT	/MULTIPLY (TEMP1 TEMP2) BY FLOP2
	CLA CLL IAC	/IGNORE LOW ORDER RESULT
	TAD FLAC0	/ADD EXPONENTS
	TAD FLOP0
	DCA FLAC0
	TAD PROD2	/SAVE PARTIAL RESULTS
	DCA FLAC3
	TAD PROD1
	DCA FLAC2
	TAD FLOP1
	JMS SDMULT	/MULTIPLY (TEMP1 TEMP2) BY FLOP1
	TAD FLAC3
	DCA FLAC3	/COMBINE RESULTS OF MULTIPLICATIONS
	RAL
	TAD PROD2
	TAD FLAC2
	DCA FLAC2
	RAL
	TAD PROD1
	DCA FLAC1
	JMS FNORM	/NORMALIZE RESULTS
	ISZ T2		/CHECK SIGN OF RESULT
	NEGATE
	JMP I FLTPT

SDMULT,	0		/UNSIGNED MULTIPLY ROUTINE
	DCA MULPLR	/24 BY 12 BITS
	DCA PROD1
	DCA PROD2
	TAD M14
	DCA FIXSGN	/SET TO COUNT 12 MULTIPLICATIONS
	CLL
SDLOOP,	TAD MULPLR	/NEW MULTIPLIER BIT INTO LINK
	RAR
	DCA MULPLR	/MULPLR ALSO ACCUMULATES LOW-ORDER
	SNL		/RESULTS
	JMP SDSHIFT
	CLL		/ADD MULTIPLIER IF BIT=1
	TAD TEMP2
	TAD PROD2
	DCA PROD2
	RAL
	TAD TEMP1
SDSHIFT,TAD PROD1	/SHIFT PRODUCT ONE TO RIGHT
	RAR
	DCA PROD1
	TAD PROD2
	RAR
	DCA PROD2
	ISZ FIXSGN
	JMP SDLOOP
	TAD MULPLR	/DONE, EXIT WITH LOW ORDER IN AC
	RAR
	JMP I SDMULT
PROD2=SGNSWT
M14,	-14

FLDIV,	TAD FLOP1	/OP 4: DIVIDE BY OPERAND
	SNA CLA
	ERROR		/TRIED TO DIVIDE BY 0
	TAD P7700	/=SMA CLA
	DCA SGNSWT
	JMS FIXSGN
	TAD FLOP0	/SUBTRACT EXPONENTS
	CIA
	TAD FLAC0
	IAC
	DCA FLAC0
	DCA FLAC1	/ZERO FLAC FOR QUOTIENT
	DCA FLAC2
	TAD M30		/SET COUNTER
	DCA DIVCNT
	JMP DVLOOP
DVSETQ,	SNL		/LINK IS QUOTIENT BIT
	JMP ZERQUO
	DCA TEMP1
	TAD TEMP3	/RESTORE LOW ORDER RESULT
	DCA TEMP2
ZERQUO,	CLA		/SHIFT RESULT BIT INTO QUOTIENT
	JMS I DRALP	/ROTATE LEFT DOUBLE PRECISION
	TAD TEMP2	/SHIFT DIVIDEND
	RAL
	DCA TEMP2
	TAD TEMP1
	RAL
	DCA TEMP1
DVLOOP,	CLL
	TAD FLOP2	/SUBTRACT DIVISOR FROM DIVIDEND
	TAD TEMP2
	DCA TEMP3
	RAL
	TAD FLOP1
	TAD TEMP1
	ISZ DIVCNT
	JMP DVSETQ
	CLA RAR		/DONE, USE RESULT OF LAST SUBTRACTION
	DCA FLAC3	/AS EXTRA PRECISION
	JMS I NOR2
	ISZ T2
	JMP I FLOT1	/RESTORE SIGN
	NEGATE
	JMP I FLOT1
FLOT1,	FPNT+1
DRALP,	DRAL
NOR2,	FNORM

RARAC,	0		/ROUTINE TO ROTATE FLAC 1 RIGHT
	CLA CLL
	TAD FLAC1
	SPA
	CML		/PROPOGATE SIGN BIT
	RAR		/SHIFT
	DCA FLAC1
	TAD FLAC2
	RAR
	DCA FLAC2
	TAD FLAC3
	RAR
	DCA FLAC3
	ISZ FLAC0	/ADJUST EXPONENT
	JMP I RARAC
	JMP I RARAC
DIVCNT=.
RAROP,	0		/ROUTINE TO SHIFT FLOP 1 RIGHT
	CLA CLL
	TAD FLOP1
	SPA
	CML
	RAR
	DCA FLOP1
	TAD FLOP2
	RAR
	DCA FLOP2
	TAD FLOP3
	RAR
	DCA FLOP3
	ISZ FLOP0
	JMP I RAROP
	JMP I RAROP
/ROUTINE TO FIX FLAC - "FIX"
/REMOVE FRACTIONAL PART BUT LEAVE FLOATING
/FIXED NUMBER IN AC ON EXIT
XFIX,	0
	CLA CLL
	TAD FLAC	/TEST EXPONENT
M30,	SPA SNA CLA	/IF -1<#<1, CLEAR ENTIRELY
	DCA FLAC	/EXCEPT FOR SIGN BIT
	TAD FLAC
	TAD FIXC
	DCA DIVCNT
	SZL
	JMP I XFIX	/TOO BIG TO FIX
	JMS RARAC	/FIX BY ROTATING FRACTIONAL BITS
	ISZ DIVCNT	/OUT OF FLAC
	JMP .-2
	DCA FLAC+3	/CLEAR FRACTIONAL PART
	TAD FLAC+2
	JMP I XFIX
FIXC,	-27
/ROUTINE TO FLOAT C(AC) AS FLOATING PT. INTEGER
/- "FLOAT"
XFLOAT,	0
	DCA FLAC1	/SAVE NUMBER
	DCA FLAC2
	DCA FLAC3
	TAD P13		/INTEGER EXPONENT
	DCA FLAC0
	JMS RARAC	/IN CASE NUMBER WAS 4000
	JMS I NOR2	/NORMALIZE
	JMP I XFLOAT

RFLAC,	RALAC
TFLAD,	TRPLAD
M4,	-4
RANDOM,	4421	/CURRENT RANDOM NUMBER
	3040
	0001
/STATISTICAL RANDOM NUMBER GENERATOR
/BASED ON DECUS 5-25, POWER RESIDUE METHOD
/NEW R=R*(2^17+3) MOD 36 BITS
FRAN,	FENT
	FGT RANDOM	/R=OLD RANDOM NUMBER
	FEXT		/ALREADY SHIFTED LEFT 12 BITS
	PUSHF
	 RANDOM
	POPF
	 FLOP1
	TAD M4		/SHIFT 4 MORE TO GET R*2^16
	DCA T1
	JMS I RFLAC
	ISZ T1
	JMP .-2
	JMS I TFLAD	/+R = R*(2^16+1)
	JMS I RFLAC	/*2 = R*(2^17+2)
	JMS I TFLAD	/+R = R*(2^17+3)
	PUSHF
	 FLAC1
	POPF
	 RANDOM		/SAVE NEW RANDOM NUMBER
	DCA FLAC3
	DCA FLAC0	/MAKE IT A 2-WORD FRACTION
	TAD FLAC1	/CHECK SIGN
	SMA CLA
	RETURN		/POSITIVE
	ISZ FLAC2	/NEGATIVE, TAKE 1S COMPLEMENT
	SKP
	ISZ FLAC1
	NEGATE
	RETURN

FLPOW,	TAD I 7	/OP 0: RAISE FLAC TO POWER
	PUSHA	/SAVE FLOATING POINTER
	PUSHF	/SAVE FLAC
	 FLAC
	POPF
	 FLTEMP
	PUSHF	/GET FLOP
	 FLOP
	POPF
	 FLAC
	FIX	/FIX OPERAND
	SPA CLA
	IAC
	TAD FLAC1
	SZA CLA
	ERROR	/RAISING TO TOO HIGH A POWER
	TAD FLAC2
	DCA XFL
	FENT	/PUT 1. IN FLAC
	FGT I ONEP
	FEXT
	TAD XFL
	SNA
	JMP FLXEND	/X^0=1, DO NOT MULTIPLY
	SMA
	JMP RAISTP	/RAISE TO + POWER
	FENT		/RAISE TO - POWER
	FDV FLTEMP
	FPT FLTEMP
	FGT I ONEP
	FEXT
	JMP .+3
RAISTP,	CIA
	DCA XFL		/SET COUNTER
	FENT		/DO MULTIPLICATIONS
	FMY FLTEMP
	FEXT
	ISZ XFL
	JMP .-4
FLXEND,	POPA		/RESTORE FLOATING POINTER
	DCA I 7
	JMP I .+1
	FPNT+1
ONEP,	FLTONE
/FLOATING SQUARE ROOT FUNCTION
FSQT,	TAD FLAC1	/TEST SIGN
	SPA
	ERROR		/SQUARE ROOT OF NEG NUMBER
	SNA CLA
	RETURN		/ZERO, RESULT IS ZERO
	TAD FLAC0	/CONSTRUCT INITIAL APPROXIMATION
	SPA		/BY HALVING EXPONENT
	CML
	RAR
	DCA FLAC0
	TAD SQCON
	DCA FLAC1
SQLOOP,	FENT		/MAKE NEW APPROXIMATION
	FPT FLTEMP	/NEW X=(N/X+X)/2
	FGT I FLARGP	/ORIGINAL ARG
	FDV FLTEMP
	FAD FLTEMP
	FEXT
	CMA
	TAD FLAC0
	DCA FLAC0
	TAD FLAC0	/COMPARE OLD AND NEW APPROXIMATIONS
	CIA
	TAD FLTEMP
	SZA CLA
	JMP SQLOOP	/EXPONENTS NOT EQUAL
	TAD FLAC1
	CIA
	TAD FLTEMP+1
	SZA CLA
	JMP SQLOOP	/HIGH ORDER NOT EQUAL
	TAD FLAC2
	CIA
	TAD FLTEMP+2
	SNA		/COMPARE LOW ORDERS TO
	RETURN		/WITHIN PLUS OR MINUS ONE BIT
	SMA
	CIA
	IAC
	SNA CLA
	RETURN
	JMP SQLOOP
SQCON,	3015
/FUNCTION TO EVALUATE SIGN PART OF FLAC
/RESULTS: -1 FOR NEGATIVE, 0 FOR ZERO, +1 FOR POSITIVE
FSGN,	TAD FLAC1
	SNA
	JMP .+4		/ZERO, SET RESULT TO 0
	SPA CLA
	TAD M2		/NEGATIVE (-1)
	IAC		/POSITIVE (+1)
	FLOAT		/FLOAT C(AC) = -1,0,1
	RETURN
DIGBUF=.	/OUTPUT DIGIT BUFFER (8 WORDS)
FLTEMP,	0	/TEMPORARY REGISTERS
	0
	0
ASKBUF=.	/"ASK" INPUT BUFFER (TO END OF PAGE)
ASKBND=7612	/END+12 OF "ASK" INPUT BUFFER
XFL,	0
*7600
	5377
$