/FLOATING-POINT PACKAGE FOR LAB-FOCAL

	*FPUTIPT1
FPNT,	0		/VIA 'FENT'
	CLA		/POINTS TO 'MOV' - SEE 'FLEX'
	RDF
	TAD CDI0	/MAKE 'CDI' TO CALLING FIELD
	DCA CDIX
CDIX,	CDI P		/THE USUAL CASE
	TAD I FPNT
	SNA
	JMP I FPNT	/EXIT
	CIF P
	JMP .+1		/REDUCE RTS/8 OVERHEAD
	CLL RTL		/SHIFT PAGE BITS OVER AND
	RTL		/PUT OPERATION CODE IN 9-11
	DCA LSCAN
	TAD LSCAN	/PAGE 0?
	SPA CLA
	TAD FPNT	/GET CURRENT PAGE
	AND P7600
	DCA XRT2	/SAVE PAGE, GET RELATIVE
	TAD I FPNT
	AND P177
	TAD XRT2	/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 LSCAN	/GET BACK THE INSTRUCTION
	AND P7		/MASK THE OP CODE
	SNA
	JMP FLGT
	TAD MPUT	/TEST IT
	SNA
	JMP FLPT
	TAD JUMPX	/SOMETHING ELSE
	DCA LSCAN
	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
LSCAN,	0		/BRANCH TO THE PROPER ROUTINE
	SKP CLA		/LOWER FIELD COMMAND SCANNER
	GETC
	TESTX		/SEARCH FOR END OF THE 2ND WORD
	JMP .-2
	SPNOR		/SKIP TO THE START OF THE THIRD
	TAD CHAR
CDI0,	CDI L
	JMP I LSCAN	/NOTE: 'CHAR' PRESERVED BELOW !

CDFV,	JMS T1		/CHANGE TO THE VARIABLES FIELD
	TAD PT1		/GET THE DATA POINTER
	JMP NOTID

JUMPX,	JMP I MPUT	/BRANCH TABLE FOR 'FPNT'
	FLAD
	FLSB
	FLDV
	FMPY
	FLPW
MPUT,	JUMPX-.
	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 CDIX	/L=0

	TAD PDLXR	/MUST BE AT 'MDRP-14'
	TAD M4
	DCA PDLXR	/EFFECTIVE PUSHF;FLAC
	JMP IBLE

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

SPECIAL,"=&177		/CHAR LIST FOR 'FETCH', 'READC'
ECHOLST,LF
	FF
	RO
	FIXUP
FLPW,	JMS FLEX	/FPWR=5
	TAD M14		/ADJUST RETURN POINT
	ISZ LSCAN
	JMP I JUMPX+4	/1 * ARG * ARG * ...
	DCA EX1
	JMP CDIX	/'0' FOR NEG. POWERS
	JMS FLEX
	JMP I JUMPX+3	/TAKE THE RECIPROCAL

FLEX,	0		/SETUP FLAC AND FLOP
	PUSHF
	    FLAC
	JMS I FPNT+1	/SAVE FLAC, GET EXPONENT
	TAD M14
	JMS I FLPW-1	/ONLY INTEGER POWERS ...
	TAD HORD
	CMA
	DCA LSCAN
	TAD SIGN	/POSITIVE OR NEGATIVE?
	SMA CLA
	TAD MDRP
	DCA FLPW+5	/SET RECIPROCAL SWITCH
	STL RTR
	FLOAT		/START WITH A FAST 1.0
	IAC
	DCA EXP
IBLE,	POPF		/RECALL THE ARGUMENT
	    FLOP
	JMP I FLEX
/////
	*ECHOLST+SP	/FOR 'CHOUT'
ECHOGO,	IECHO+1		/LF
	IECHO-2		/FF
	IECHO-2		/RO
/////
	*SORTB-6	/FILL IN A HOLE
SMQX,	0
	SWP
	DCA MQSV	/SAVE THE MQ
	MQA
	SWAB		/SET MODE 'B'
	JMP I SMQX
/////
	PAGE 33
/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
	CLL IAC		/ADD ONE TO EXPONENT
	TAD EXP
	DCA EXP
	JMS ABSOLV	/TAKE THE ABSOLUTE VALUE
	TAD SIGN
	SNA
	JMP MDXIT	/QUICK RETURN
	AND P4000	/STRIP THE SIGN BIT
	TAD AC1H	/DO AN EXCLUSIVE OR
	DCA SIGN	/AND SAVE THE RESULT
	SMQ		/SAVE MQ, SET MODE B
	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 I CSTAR	/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
	SWP MUY
	    OVR1
	MQL		/SAVE HIGH ORDER & ERASE SIX

	TAD LORD	/B*F
	SWP MUY		/USE PREVIOUS HIGH ORDER AS
	    OVR1	/REMAINDER IN THIS POSITION
	DCA EX1		/SAVE FOUR

	TAD OVER	/C*E
	SWP MUY		/ADD IN PREVIOUS
	    AC1L	/PARTIAL PRODUCT
	TAD EX1		/SUM HIGH ORDER PARTS
	MQL		/DISCARD FIVE
	RAL
	DCA EX1		/AND SAVE CARRY
	TAD HORD	/A*F
	SWP MUY
	    OVR1
	TAD EX1		/BUILD UP THREE
	DCA EX1

	TAD OVER	/C*D
	SWP MUY
	    AC1H
	TAD EX1
	DCA EX1		/ADD TO THREE

	TAD LORD	/B*E
	SWP MUY
	    AC1L
	TAD EX1
	SWP		/SAVE THREE, CHECK FOUR
	AND P4000
	RAL
	DCA EX1		/SAVE CARRY IN TWO
	SZL
	DPIC		/ROUND UP

	TAD HORD	/A*E
	SWP MUY
	    AC1L
	TAD EX1
	DCA EX1		/ADD TO TWO

	TAD LORD	/B*D
	SWP MUY
	    AC1H
	TAD EX1
	SWP
MDONE,	DCA OVER	/SAVE THREE

	TAD HORD	/A*D
	SWP MUY
	    AC1H
	SWP
	DCA LORD	/SAVE TWO

DVXIT,	RMQ
	DCA HORD	/SAVE ONE
	TAD I CSTAR
MDXIT,	TAD FPNTP3	/COMPUTE THE RETURN POINT
	DCA RESOLV
	NORMALIZE
	JMP RESOLV+1	/EXIT FROM MULTIPLY / DIVIDE
/////
P4000,	4000
FPNTP3,	MDRP
/////
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		/2'S COMPLEMENT FLAC - 'NEGATE'
	TAD OVER	/ENTER WITH AC=1 FOR 1'S COMPL.
	CLL CIA
	DCA OVER
	CML RAL
	TAD LORD
	CIA
	DCA LORD
	CML RAL
	TAD HORD
	CIA
	DCA HORD
	JMP I INVERT

REVERS,	0		/DITTO - 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
/////

	MUY=7405	/EAE INSTRUCTIONS
	DVI=7407
	NMI=7411
	SHL=7413
	SWAB=7431
	SCA=7441
	DAD=7443
	DST=7445
	SWBA=7447
	DPSZ=7451
	SAM=7457
	DPIC=7573
	CAM=7621
	DLD=7663
/THREE-WORD BY THREE-WORD EAE DIVIDE ROUTINE

FLDV,	DCA I CSTAR	/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 SCNT	/SAVE THE TRIAL DIVISOR
	JMP DVLP+1

DADJ,	DCA LORD	/RESTORE THE OVERDRAUGHT
	SM1
	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 SCNT
	JMP DVCK	/CHECK FOR SUCCESS AGAIN

DVSB,	0		/MULTIPLY QUOTIENT*DIVISOR
	SWP MUY		/AND SUBTRACT FROM DIVIDEND
	    QUOT
	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
	SNL		/PROCESS THE CARRY
	DPIC
	JMP I DVSB	/CALLED TWELVE TIMES
DVXP,	DVXIT

	QUOT=AC1H
/	DVSR=SCNT
/	8/E-EAE SIGNED NORMALIZE ROUTINE:

NORM,	0
	CLA CLL		/BOTH MAY NEED IT
	TAD LORD
	SMQ		/LOAD AC, MQ
	TAD HORD
	SPA		/COPY SIGN
	STL
	NMI		/WIPES OUT 4000 0000!
	MQL SCA
	DPSZ		/CHECK FOR 0000 0000
	CLL CIA
	TAD P14		/L=1 IF NZ AND LT 14
	CLA SCA
	DCA SCNT	/SAVE SHIFT COUNT
	TAD OVER
	SWP DPSZ	/CHECK FOR ALL-ZERO
	JMP NOT0
	SNL		/L=1 IF IT WAS 4000
	JMP ALL0 
	JMS I SHFR	/MAKE IT: 6000 0000
	JMP ALL0+1

NOT0,	SNA		/WATCH FOR 0 0 XXXX
	SNL		/PRESERVE 4000 0000
	DCA HORD
	TAD LORD	/LOAD AC, TEST SCNT
	SNL
	JMP GE14	/HAVE TO RENORMALIZE
	SHL
SCNT,	0		/SHIFT LOWER 2 WORDS
	DCA LORD
	TAD SCNT
	CIA
	TAD EXP		/ADJUST THE EXPONENT
ALL0,	DCA EXP
	RMQ
	DCA OVER	/SAVE OR CLEAR LAST WORD
	JMP I NORM

GE14,	NMI		/NORMALIZE LOW ORDER
	SWP DST
	    HORD
	CAM SCA		/GET NEW SHIFT COUNT
	TAD P14
	JMP ALL0-2	/PLUS A 1-WORD OFFSET
/////
IFNZRO	STL IAC-.-1	<FX10 CALLS WON'T WORK!>
	EX1
FX10,	0		/MULTIPLY FLAC BY TEN
	FENT
	FMUL I ALL0	/FL10
	FEXT
	JMP I FX10	/CALLED BY 'PRINTN', 'GET10X'
DVLP,	DCA I XRT2	/ONLY 2 TIMES: XRT, THEN XRT2!!
	DLD		/LOAD 24 BITS OF THE DIVIDEND
	    HORD
	SWP DVI		/CALLED THREE TIMES
	    SCNT	/THE TRIAL DIVISOR
	CLA SWP		/GET THE ANSWER
	SZL		/DIVIDE CHECK?
	STA		/SET TO THE MAXIMUM
	DCA QUOT	/SAVE THE PARTIAL QUOTIENT
	DCA EX1		/CLEAR THE GUARD WORD
	TAD FX10-1	/INITIALIZE THE WORD POINTER
	DCA NORM
	TAD OVR1	/FORM: DIVIDEND-QUOT*DIVISOR
	JMS DVSB
	TAD AC1L
	JMS DVSB
	TAD SCNT
	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
	TAD XRT2	/SAVE THE FULL QUOTIENT
	DCA LORD
	TAD XRT
	SMA		/CHECK THE 'SIGN' BIT
	JMP .+5
	DCA HORD
	JMS I .+1	/SHIFT RIGHT A BIT
SHFR,	SM0		/POINTS TO 'DIV2'
	TAD HORD	/CLEAR THE SIGN BIT
	MQL		/(NEEDED FOR 'RMQ')
	JMP I DVXP	/CONCLUDE EAE DIVDE

	*PRODUCT	/SAVE AND RESTORE MQ
RMQ=	JMS .
RMQX,	0		/RESTORE IT
	TAD MQSV
	SWP
	JMP I RMQX
MQSV,	0
SMQ=	JMS I .
	SMQX
/SHIFT ROUTINES FOR 'FLAC' AND 'FLOP'

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

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

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

	TAD EX1		/EXPONENTS EQUAL?
	CIA
	TAD EXP
	SNA
	JMP AOK		/YES: WE'RE DONE
	DCA MOV

	TAD MOV		/NO: SAVE THE MISMATCH
	SMA
	CIA		/NEGATE FOR LOOP COUNT
	DCA XRT2

	TAD XRT2
ALC,	TAD P43		/'P27' FOR 3-WORD VERSION
	SPA CLA		/CAN THEY BE ALIGNED?
	JMP NOGO	/NO

ALP,	TAD MOV		/YES, SHIFT THE SMALLEST
	SMA
	JMS DIV1	/FLOP
	SPA
	JMS DIV2	/FLAC
	ISZ XRT2
	JMP ALP		/REPEAT
AOK,	ISZ ALIGN
	JMP I ALIGN	/TAKE THE SECOND RETURN

IFNZRO	.-"*&177	<'CSTAR' WON'T BE RIGHT>
/TURN THE FLOATING ACCUMULATOR INTO A 24-BIT INTEGER WITH
/THE LEAST MOST SIGNIFICANT 12 BITS IN THE AC UPON RETURN

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

NOGO,	SM0		/MISSION IMPOSSIBLE
	AND EX1
	TAD EXP		/FIND OUT WHO'S BIGGEST
	SPA CLA
	TAD EXP		/SIGNS DIFFER: TEST 'EXP'
	SNA
	TAD MOV		/SIGNS EQUAL: CHECK DIFF.
	SPA CLA
FLIP,	JMS MOV		/EX1 > EXP
	JMP I ALIGN	/EXP > EX1
/////
	REVERS
FLSB,	JMS I .-1	/FSUB=2 - NEGATE THE OPERAND
FLAD,	JMS ALIGN	/FADD=1 - ALIGN EXPONENTS
	JMP FLNR	/NOT POSSIBLE
	SM0
	AND HORD	/COMPARE SIGNS
	TAD AC1H
	SMA CLA
	JMP SHFTR1	/SHIFT RIGHT ONCE
	JMP FLNR-1
/////
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
IOBADR,	IOB		/'NOP'
	JMP I DIV1
/////
	*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
/////

SHFTR1,	JMS DIV2	/SHIFT THE NUMBERS RIGHT ONCE
	JMS DIV1	/WHEN THEY HAVE THE SAME SIGN
	RAR
	TAD DIV2	/ADD THE BITS WE SHIFTED OUT
	CLA RAL
	JMS I ADD2	/ADD THE REST OF THE MANTISSA
FLNR,	NORMALIZE	/FNOR=7 - CALL NORMALIZE
	JMP I FLNX
/////

FIXUP,	0		/FIXUP A FLOATING POINT NUMBER
	TAD P27
	DCA EX1		/SAVE THE DESIRED BINARY POINT
	TAD EXP
	SPA SNA CLA	/IS NUMBER GREATER THAN ONE?
	FLOAT		/NO, RETURN ZERO (EXP=13)
	JMS I ABSOL	/NECESSARY FOR NEG. VALUES
	TAD HORD
	DCA AC1H	/IGNORE UNNORMALIZED NUMBERS
	JMS ALIGN
IFNZRO	STA STL RTR-.	<REFERENCES TO 'TERM' FAIL>
TERM,	0		/INPUT TERMINATOR
	JMP I FIXUP	/USED BY 'FIXIT' 'FRAC' 'FLPW'
/////

/ ENTRY POINT FOR I/O TO INTERNAL BUFFERS ('I B','O B')

IO2BUF,	0		/CALLED VIA 'INDEV' OR 'OUTDEV'
	CDI L
	JMP I IOBADR	/C(AC) DETERMINES 'IN' OR 'OUT'
	JMP I IO2BUF
/////
	PAGE