/FLOATING POINT PACKAGE FOR U/W-FOCAL

	*FPUTIPT1
FPNT,	0		/VIA 'FENT'
	CLA		/= PAGE 35
	CDF P		/RESET DATA FIELD
	TAD I FPNT
	SNA
	JMP I FPNT	/EXIT
	CLL RTL		/SHIFT PAGE BITS OVER AND
	RTL		/PUT OPERATION CODE IN 9-11
	DCA LSORT
	TAD LSORT	/PAGE 0?
	SPA CLA
	TAD FPNT	/GET CURRENT PAGE
	AND P7600
	DCA T1		/SAVE PAGE, GET RELATIVE
	TAD I FPNT
	AND P177
	TAD T1		/MERGE
	SNL		/IS IT INDIRECT?
	JMP NOTID	/NO
	SNA		/IS IT OUT-OF-FIELD?
	JMP CDFV	/YES
	DCA T1
	TAD I T1	/GET THE INDIRECT ADDRESS
NOTID,	CIA
	CMA CLL		/BACKUP ONE
	DCA XRT2	/LOAD THE INDEX REGISTER

	ISZ FPNT	/ADVANCE PROGRAM COUNTER
	TAD LSORT	/GET BACK THE INSTRUCTION
	AND P7		/MASK THE OP CODE
	SNA
	JMP FLGT
	TAD M6		/TEST IT
	SNA
	JMP FLPT
	TAD JUMPX	/SOMETHING ELSE
	DCA LSORT
	TAD I XRT2	/LOAD THE OPERAND
	DCA EX1
	TAD I XRT2
	DCA AC1H
	TAD I XRT2
	DCA AC1L
	TAD I XRT2	/'DCA OVER' FOR 3-WORD VERSION
	DCA OVR1
	CDF P
LSORT,	0		/BRANCH TO THE PROPER ROUTINE
	SKP CLA		/LOWER FIELD COMMAND SCANNER
	GETC
	SORTX		/SEARCH FOR END OF THE 2ND WORD
	JMP .-2
	SPNOR		/SKIP TO THE START OF THE THIRD
	CIF L
	JMP I LSORT	/NOTE: 'CHAR' PRESERVED BELOW !

CDFV,	CDF V		/CHANGE TO THE VARIABLES FIELD
	TAD PT1		/GET THE DATA POINTER
	JMP NOTID

JUMPX,	JMP I M6	/BRANCH TABLE FOR 'FPNT'
	FLAD
	FLSB
	FLDV
	FMPY
	FLEX
M6,	-6
	FLNR

/HERE ARE THE FLOATING POINT OPERATIONS:

FLGT,	TAD I XRT2	/FGET=0
	DCA EXP
	TAD I XRT2
	DCA HORD
	TAD I XRT2
	DCA LORD
	TAD I XRT2	/'NOP' FOR 3-WORD VERSION
	DCA OVER
	JMP FPNT+2	/L=0

FLPT,	TAD EXP		/FPUT=6
	DCA I XRT2
	TAD HORD
	DCA I XRT2
	TAD LORD
	DCA I XRT2
	TAD OVER	/'JMP FPNT+2' FOR 3-WORD VERSION
	DCA I XRT2
	JMP FPNT+2	/L=1
/////

FLTONE,	1;2000;0;0	/USED BY 'FOR' 'Y' 'FLOG' & 'FSIN'
FLEX,	PUSHF		/FPWR=5
	    FLAC
	JMS I FPNT+1	/SAVE FLAC AND MOVE EXPONENT
	FIXIT		/ONLY HANDLES INTEGER POWERS
	SMA
	CMA		/BUT THEY MAY BE EITHER
	DCA LSORT	/POSITIVE -OR- NEGATIVE!
	TAD HORD
	DCA SIGN	/SAVE SIGN OF EXPONENT
	IAC
	FLOAT		/START WITH UNITY
	NORMALIZE

IBLE,	POPF		/RECALL THE ARGUMENT
	    FLOP
	TAD (.+4-FPNT-3	/LOAD THE RETURN ADDRESS
	ISZ SIGN	/CHECK THE DIRECTION
	JMP .+5
	JMP I M6-3	/TAKE THE INVERSE (ONCE)
	PUSHF		/SAVE THE RECIPROCAL
	    FLAC
	JMP IBLE

	TAD P7		/ADVANCE THE RETURN
	ISZ LSORT	/CHECK THE LOOP COUNT
	JMP I M6-2	/ACCUMULATE THE PRODUCT
	JMP FPNT+1	/DONE
	TAD M4
	TAD PDLXR	/REUSE THE SAME DATA
	DCA PDLXR
	JMP IBLE
/////

FMQ,	FIXIT		/DISPLAY A NUMBER IN THE MQ
	MQL
	RETURN		/LINC-MODE VERSION IS LONGER
/////

IFZERO	T-20		<
FDAY,	FIXIT		/READ OR CHANGE THE SYSTEM DATE
	CIF T
	JMP DAY		>

	*.!177-6	/BRANCH LIST FOR 'FETCH'
ACTION,	ENDFI		/ESCAPE = RETAIN CURRENT
	ENDFI		/ALTMODE = DITTO
	READ		/BA = RESTART INPUT
	ACCEPT		/FF = IGNORE IT
	ACCEPT		/LF = IGNORE IT
	ACCEPT		/RO = IGNORE IT

	PAGE
/THIS ROUTINE COMBINES THE EXPONENTS FOR MULTIPLY AND
/DIVIDE AND DETERMINES THE SIGN OF THE RESULT; IF THE
/RESULT IS ZERO IT EXITS IMMEDIATELY.

SGNTST,	0		/TEST AND SAVE SIGN OF THE RESULT
	IAC		/ADD ONE TO EXPONENT
	TAD EXP
	DCA EXP
	JMS ABSOLV	/TAKE THE ABSOLUTE VALUE
	TAD SIGN
	SNA
	JMP MDXIT+6	/QUICK RETURN
	AND P4000	/STRIP THE SIGN BIT
	TAD AC1H	/DO AN EXCLUSIVE OR
	DCA SIGN	/AND SAVE THE RESULT
	SWP
	DCA ABSOLV	/CLEAR & SAVE THE MQ
	TAD AC1H
	SZA
	ISZ SGNTST
	SPA CLA		/TEST SIGN OF OPERAND
	JMS REVERS	/FOR BOTH MULTIPLY AND DIVIDE
	JMP I SGNTST
/////


/THREE-WORD BY THREE-WORD MULTIPLICATION:
/THE ANSWER IS ROUNDED OFF TO THREE WORDS

/ (A+B+C)*(D+E+F) = NINE PARTIAL PRODUCTS

FMPY,	DCA T1		/SAVE THE RETURN ADDRESS
	TAD EX1		/ADD THE EXPONENTS (PLUS 1)
	JMS SGNTST	/AND DETERMINE THE SIGN OF RESULT
	JMP MDONE	/THE RESULT IS ZERO!

	TAD OVER	/C*F
	DCA .+3
	TAD OVR1
	MQL MUY
	0
	MQL		/SAVE HIGH ORDER & ERASE SIX

	TAD LORD	/B*F
	DCA .+3
	TAD OVR1
	SWP MUY		/USE PREVIOUS HIGH ORDER AS
	0		/REMAINDER IN THIS POSITION
	TAD P4000	/ROUND UP
	DCA SGNTST	/SAVE FOUR
	RAL
	DCA EX1		/SAVE CARRY
	TAD OVER	/C*E
	DCA .+3
	TAD AC1L
	SWP MUY		/ADD IN PREVIOUS
	0		/PARTIAL PRODUCT
	TAD SGNTST	/SUM HIGH ORDER PARTS
	MQL		/DISCARD FIVE
	SZL
	ISZ EX1		/ACCUMULATE CARRIES

	TAD HORD	/A*F
	DCA .+3
	TAD OVR1
	SWP MUY
	0
	TAD EX1		/BUILD UP THREE
	DCA EX1

	TAD OVER	/C*D
	DCA .+3
	TAD AC1H
	SWP MUY
	0
	TAD EX1
	DCA EX1		/ADD TO THREE

	JMS I MEND	/DO 'B*E', 'A*E', AND 'B*D'
	SWP
MDONE,	DCA OVER	/SAVE THREE

	TAD HORD	/A*D
	DCA .+3
	TAD AC1H
	SWP MUY
	0
MDXIT,	DCA HORD	/SAVE ONE
	SWP
	DCA LORD	/SAVE TWO
DVXIT,	TAD ABSOLV
	MQL
	TAD T1
	TAD FPNTP3	/COMPUTE THE RETURN POINT
	DCA RESOLV
	NORMALIZE
	JMP RESOLV+1	/EXIT FROM MULTIPLY / DIVIDE
/////
MEND,	MPLY		/SOFTWARE MULTIPLY AREA
P4000,	4000
FPNTP3,	FPNT+3
/////
ABSOLV,	0		/TAKE THE ABSOLUTE VALUE
	TAD HORD
	DCA SIGN	/BUT REMEMBER WHAT IT WAS
	JMS RESOLV
	JMP I ABSOLV

RESOLV,	0		/RESTORE THE PROPER SIGN
	TAD SIGN
	SPA CLA
	JMS INVERT
	JMP I RESOLV

INVERT,	0		/COMPLEMENT FLAC - 'NEGATE'
	TAD OVER
	CLL CIA
	DCA OVER
	CML RAL
	TAD LORD
	CIA
	DCA LORD
	CML RAL
	TAD HORD
	CIA
	DCA HORD
	JMP I INVERT

REVERS,	0		/NEGATE THE OPERAND
	TAD OVR1
	CLL CIA
	DCA OVR1
	CML RAL
	TAD AC1L
	CIA
	DCA AC1L
	CML RAL
	TAD AC1H
	CIA
	DCA AC1H
	JMP I REVERS

/EAE INSTRUCTIONS:

	MUY=7405
	DVI=7407
	NMI=7411
	SHL=7413
	MQL=7421
	SCA=7441
	CAM=7621
/THREE-WORD BY THREE-WORD EAE DIVIDE ROUTINE

	*6766
FLDV,	DCA T1		/SAVE THE RETURN POINT
	TAD EX1		/SUBTRACT THE EXPONENTS
	CMA		/COMPENSATE FOR SHIFT
	JMS SGNTST
	ERROR2		/THE DIVISOR IS ZERO!
	SM3
	DCA RESOLV	/SET THE COUNTER
	TAD P13		/'XRT-1'
	DCA XRT2	/INITIALIZE QUOTIENT POINTER
	TAD OVR1
	CLL RAL
	DCA OVR1	/SHIFT THE OPERAND TO THE LEFT
	TAD AC1L
	RAL
	DCA AC1L
	TAD AC1H
	RAL
	DCA DVSR	/SAVE THE TRIAL DIVISOR
	JMP DVLP+1
/////

DADJ,	DCA LORD	/RESTORE THE OVERDRAUGHT
	STA STL RTL	/POINTS TO 'AND EX1'
	TAD QUOT	/REDUCE THE QUOTIENT
	DCA QUOT
	TAD OVR1	/NOW ADD IN THE DIVISOR
	TAD EX1
	DCA EX1		/THE LEAST-SIGNIFICANT WORD
	RAL
	TAD AC1L
	TAD OVER
	DCA OVER
	RAL
	TAD DVSR
	JMP DVCK	/CHECK FOR SUCCESS AGAIN
/////

DVSB,	0		/MULTIPLY QUOTIENT*DIVISOR
	SWP		/AND SUBTRACT FROM DIVIDEND
	SNL
	IAC		/ADD IN THE PREVIOUS CARRY
	MUY
QUOT,	0
	SWP		/GET BITS FOR THIS POSITION
	CLL CIA
	TAD I NORM	/SUBTRACT FROM THE DIVIDEND
	DCA I NORM
	CMA CML
	TAD NORM	/BACKUP AND REVERSE THE LINK
	DCA NORM
	JMP I DVSB	/CALLED TWELVE TIMES
/THIS NORMALIZE ROUTINE WORKS FOR BOTH POSITIVE & NEGATIVE
/NUMBERS, PRESERVING THE VALUE OF 'SIGN' FOR USE LATER ON.

NORM,	0		/NORMALIZE THE FLAC - 'NORMALIZE'
	SM0		/=4000
	AND HORD
	DCA XRT2	/SIGN BIT
	TAD HORD
	SNA
	TAD LORD
	SNA
	TAD OVER
	SZA CLA		/MANTISSA=0 ?
	JMP NORGO
	DCA EXP
	JMP I NORM	/YES

NORML,	SHIFTL		/ONE BIT AT A TIME
	CMA
	TAD EXP
	DCA EXP
NORGO,	TAD HORD
	RAL
	TAD XRT2	/COMPARE SIGN & BIT 1
	SMA CLA		/ARE THEY DIFFERENT ?
	JMP NORML	/NOT YET

	SM0		/CHECK FOR 4000 .....
	TAD HORD
/	SNA
/	TAD OVER
	SNA CLA
	JMS I NORM+1	/SHIFT IT BACK A BIT
	JMP I NORM
/////
	TAD BUFR
	DCA AXOUT	/SET 'TEXTP'
	DCA XCT		/CONTINUE LINEFEED
	TAD CCR		/START WITH A CR
	PRINTC
	TAD I C200	/THEN PRINT A STAR
	ISZ I DMPSW	/PREVENT STUTTERING
LFCONT,	PRINTC		/RETYPE THE INPUT LINE
	GETC
	TAD AXIN
	CIA		/THROUGH THE CURRENT POSITION
	TAD AXOUT
	SPA CLA
	JMP LFCONT
	TAD T3		/CHECK FOR AN EXTRA CHARACTER
	SPA CLA
	PRINTC
	CMA
	TAD AXIN
	JMP I CCR	/RESET PACKING POINTERS
DVLP,	DCA I XRT2	/ONLY 2 TIMES: XRT, THEN XRT2!!
	TAD LORD
	MQL		/LOAD 24 BITS OF THE DIVIDEND
	TAD HORD
	DVI		/CALLED THREE TIMES
DVSR,	0		/THE TRIAL DIVISOR
	STA		/SET TO THE MAXIMUM
	SNL		/DIVIDE CHECK?
	SWP		/GET THE ANSWER
	DCA QUOT	/SAVE THE PARTIAL QUOTIENT

	DCA EX1		/CLEAR THE GUARD WORD
	TAD I DADJ+1	/INITIALIZE THE WORD POINTER
	DCA NORM
	TAD OVR1	/FORM: DIVIDEND-QUOT*DIVISOR
	JMS DVSB
	TAD AC1L
	JMS DVSB
	TAD DVSR
	JMS DVSB
	JMS DVSB	/FINISH PROCESSING DVSR

DVCK,	TAD LORD	/CHECK FOR SUCCESS
	SNL
	JMP DADJ	/TOO BIG, CORRECT QUOTIENT
	DCA HORD	/SHIFT THE REMAINDER LEFT
	TAD OVER
	DCA LORD
	TAD EX1		/THE 'GUARD WORD'
	DCA OVER
	TAD QUOT
	ISZ I RESOL	/CHECK THE LOOP COUNTER
	JMP DVLP

	DCA OVER	/SAVE THE FULL QUOTIENT
	TAD XRT2
	DCA LORD
	TAD XRT
	SMA		/CHECK THE 'SIGN' BIT
	JMP .+5		/OK, SAVE HORD
	DCA HORD
	JMS I .+1	/SHIFT RIGHT A BIT
	SM0		/POINTS TO 'DIV2'
	TAD HORD	/CLEAR THE SIGN BIT
	DCA HORD
	JMP I (DVXIT	/CONCLUDE EAE DIVIDE

	PAGE
	*CLA		/ FOR 'FLEX'
	0		/ FLOP -> FLAC
	TAD EX1
	DCA EXP
	TAD AC1H
	DCA HORD
	TAD AC1L
	DCA LORD
	TAD OVR1
	DCA OVER
	JMP I CLA
/////

ALIGN,	0		/SUBROUTINE TO LINE THINGS UP
	TAD AC1H	/IS THE OPERAND ZERO?
	SNA CLA
	JMP I ALIGN	/DON'T WASTE ANY TIME

	TAD HORD	/IS FLAC ZERO ?
	SNA
	TAD LORD
	SNA CLA
	JMP OSHFT 	/YES, FLOP -> FLAC

	TAD EX1		/ARE THE EXPONENTS EQUAL?
	CIA
	TAD EXP
	SNA
	JMP AOK		/YES, SO THERE'S NOTHING TO DO
	DCA CLA
	TAD CLA		/SAVE AND CHECK THE DIFFERENCE
	SMA
	CIA		/NEGATE FOR LOOPING
	DCA T1
	TAD T1		/CAN THEY BE ALIGNED?
ALC,	TAD P43		/'P27' FOR 3-WORD VERSION
	SPA CLA
	JMP NOWAY	/NO, USE THE BIGGEST ONE

	TAD CLA		/YES, WHICH ONE IS BIGGER?
	SMA
	JMS DIV1	/FLAC
	SPA
	JMS DIV2	/FLOP
	ISZ T1
	JMP .-6		/REPEAT
AOK,	ISZ ALIGN
	JMP I ALIGN
/////
	JMS DIV2	/OPERANDS HAVE THE SAME SIGN
	JMS DIV1	/SO SHIFT THEM RIGHT ONCE AND
	RAR
	TAD DIV2	/ADD THE LEAST-SIGNIFICANT BITS
	CLA RAL
	JMP FLNR-1	/THEN ADD THE REST
/TURN THE FLOATING ACCUMULATOR INTO A 24-BIT INTEGER WITH
/THE LEAST MOST SIGNIFICANT 12 BITS IN THE AC UPON RETURN


INTEGER,0		/'FIXIT'
	TAD P27
	JMS FIXER	/CONVERT TO A 24-BIT INTEGER
	DCA OVER	/CLEAR THE FRACTION
	JMS I RESOL
	CLL		/VERY USEFUL!
	TAD LORD
	JMP I INTEGER
/////

FIXER,	0		/FIX UP A FLOATING POINT NUMBER
	DCA EX1		/SAVE THE DESIRED BINARY POINT
	TAD EXP
	SPA SNA CLA	/IS IT GREATER THAN ONE?
	JMP NOFIX	/NO, RETURN ZERO
	JMS I ABSOL	/NECESSARY FOR NEG. VALUES
	DCA AC1H
	TAD HORD	/IGNORE UNNORMALIZED NUMBERS
	JMS ALIGN	/DO IT...
P27,	27
	JMP I FIXER	/DONE

NOFIX,	FLOAT		/STUFF WITH ZEROS
	DCA EXP
	JMP I FIXER
/////

	*CLA CLL RTL	/FOR 'FRA'

DIV1,	0		/SHIFT FLOP RIGHT
	CLA RAR
	DCA DIV2
	TAD AC1H
	SPA
	CML
	RAR
	DCA AC1H
	TAD AC1L
	RAR
	DCA AC1L
	TAD OVR1
	RAR
	DCA OVR1
	ISZ EX1
	JMP I DIV1
	JMP I DIV1
/////
FP3,	FPNT+3
	*SM0		/FOR NORMALIZE, DIVIDE
DIV2,	0		/SHIFT FLAC RIGHT
	CLA CLL
	TAD HORD
	SPA
	CML
	RAR
	DCA HORD
	TAD LORD
	RAR
	DCA LORD
	TAD OVER
	RAR
	DCA OVER
	ISZ EXP
	JMP I DIV2
	JMP I DIV2
/////

	REVERS
FLSB,	JMS I .-1	/FSUB=2 - NEGATE THE OPERAND
FLAD,	JMS ALIGN	/FADD=1 - ALIGN EXPONENTS
	JMP I FP3	/NOT POSSIBLE
	SM0
	AND HORD	/COMPARE SIGNS
	TAD AC1H
	SMA CLA
	JMP AOK+2	/SIMILAR: SHIFT RIGHT ONCE
	JMS I (DUBLAD
FLNR,	NORMALIZE	/FNOR=7 - CALL NORMALIZE
	JMP I FP3
/////
	*CLA SM1	/FOR 'ASK' AND EAE DIVIDE
TERM,	0		/INPUT TERMINATOR

NOWAY,	SM0		/MISSION IMPOSSIBLE
	AND EX1		/POINTER FOR EAE DIVIDE
	TAD EXP		/FIND OUT WHO'S BIGGEST
	SPA CLA
	TAD EXP		/SIGNS DIFFER: TEST 'EXP'
	SNA
	TAD CLA		/SIGNS EQUAL: CHECK DIFF.
	SPA CLA
OSHFT,	JMS CLA		/EX1 > EXP
	JMP I ALIGN	/EXP > EX1

	PAGE
