.TITLE  REAL FLOATING POINT 
	.GLOBL .AH,.AP,.AO,.AG,.AI,.AR
	.GLOBL .AK,.AT,.AQ,.AL,.AU,.AM
	.GLOBL .BA,.AA,.AB,.AC,.AW,.AX
	.GLOBL .AJ,.AS,.AV,.AN,.CB,.ER
	.GLOBL .RB,.FS,.CH,.CD,.ZS
	.GLOBL .CI,.CE,.T1,.SET,.CC,.CA
	.GLOBL .A4,.HS,.HX,.RE,.SP
	/.AH-STORE SINGLE PRECISION
.AH	CAL	0
	LAC*	.AH
	JMS	.CB	/CLEARS LINK
	JMS	.ZRSN	/CHECK FOR 0
	LAC	.AA
	DAC*	CE14	/SAVE EX
	SZL
	JMP	AH01	/0 RESULT
	LAC	STW
	DAC	ERN
	LAC	.AC
	TAD	REAL02	/ROUND BIT
	AND	REAL04	/EXTRACT LO
	DAC	T2	/SAVE LO
	GLK
	TAD	.AB
	SNA		/=0?
	TAD	(600000	/YES
	SAD	CN01	/=400000?
	JMP	.-2	/YES
/IF ARITH OV L=1,A=200000 IF+,A=600000 IF-
	DAC	T1	/SAVE HI
	GLK		/0 IF NO OV
	TAD*	CE14	/CHECK EX
	TAD	(377400	/FOR OV
	SZL		/& UNF
	JMP	.OV	/L=1,A0=0
	TAD	(1000
	SNL!CLL
	JMP	UNF	/L=0,A0=1
	XOR	T2	/ADD LO
	XOR	REAL02	/CHANGE SIGN
	DAC*	CE14	/STORE LO-EX
	LAC	T1
AH01	ISZ	CE14
	DAC*	CE14	/STORE HI
	JMP*	.AH
UNF	LAW	2
	JMS	ERP
	CLA!STL		/CREATE 0
	JMP	.AH+5
/
	/.AP-STORE DOUBLE PRECISION
.AP	CAL	0
	LAC*	.AP
	JMS	.CB	/GET ARG
	JMS	.ZRSN	/CHECK FOR 0
	LAC	.AA
	SNL
	XOR	CN01	/REMOVE BIAS
	DAC*	CE14	/STORE EX
	ISZ	CE14
	LAC	.AB
	DAC*	CE14	/STORE HI
	ISZ	CE14
	LAC	.AC
	DAC*	CE14	/STORE LO
	LAC	.AB
	JMP*	.AP
/
	/.ZRSN-CHECK FOR 0 & INSERT SIGN
.ZRSN	CAL	0
	LAC	.AB
	AND	CN02	/377777
	SAD	.AC
	SZA!STL
	JMP	.+4
	DZM	.AA	/0 TO EX
	DZM	CE05	/+ SIGN
	JMP*	.ZRSN
	LMQ		/.AB TO MQ
	LAC	CE05	/GET SIGN
	AND	CN03
	RTR!CLL		/SIGN TO A0
	OMQ	/PACK SIGN & FRAC
	DAC	.AB
	JMP*	.ZRSN
.ZS=.ZRSN
/
	/.AO .AG -LOAD
.AO	CAL	0	/DOUBLE LOAD
	LAC	.-1
	JMS	.SET
.AG	CAL	0	/SINGLE LOAD
	LAC*	.AG
	JMS	.CB	/GET ARG ADR
	JMS	.FRE	/ARG TO HAC
STW	123124		/ST
	JMS	.XFR	/EXC HAC&FAC
	JMS	.XSE	/EXC SIGN&EX
	JMS	.ZRSN	/INSERT SIGN
	JMP*	.AG
/
	/.AQ .AI  ADD
.AQ	CAL	0	/DOUBLE ADD
	LAC	.-1
	JMS	.SET
.AI	CAL	0	/SINGLE ADD
	LAC*	.AI
	JMS	.CB
	JMS	.FRE	/ARG TO HAC
	101104		/AD
	JMS	.CC	/GEN. ADD
	JMS	.NORD	/NORM-RD-OV
	JMP*	.AI
/
	/.AR  .AJ -SUBTRACT
.AR	CAL	0	/DOUBLE SUB
	LAC	.-1
	JMS	.SET
.AJ	CAL	0	/SINGLE SUB
	LAC*	.AJ
	JMS	.CB
	ISZ	CE05	/CHANGE SIGN
	JMS	.FRE
	123102		/SB
	JMS	.CC	/GEN. ADD
	ISZ	CE05	/CHANGE SIGN
	JMS	.NORD	/NORM-RD-OV
	JMP*	.AJ
/
	/.AS  .AK -MULTIPLY
.AS	CAL	0	/DOUBLE MULT
	LAC	.-1
	JMS	.SET
.AK	CAL	0	/SINGLE MULT
	LAC*	.AK
	JMS	.CB
	JMS	.FRE
	115114		/ML
	JMS	.CA	/GEN. MULT
	JMP*	.AK
/
	/.AT  .AL -DIVIDE
.AT	CAL	0	/DOUBLE DIV
	LAC	.-1
	JMS	.SET
.AL	CAL	0	/SINGLE DIV
	LAC*	.AL
	JMS	.CB
	JMS	.FRE
	104126		/DV
	JMS	.XSE
	JMS	.XFR
	JMS	.CI	/GEN. DIVIDE
	JMP*	.AL
/
	/.AU  .AM -REVERSE SUB
.AU	CAL	0	/DOUBLE RSUB
	LAC	.-1
	JMS	.SET
.AM	CAL	0	/SINGLE RSUB
	LAC*	.AM
	JMS	.CB
	ISZ	CE05	/CHANGE SIGN
	JMS	.FRE
	122123		/RS
	JMS	.CC	/GEN. ADD
	JMS	.NORD	/NORM-RD-OV
	JMP*	.AM
/
	/.AV  .AN -REVERSE DIV
.AV	CAL	0	/DOUBLE RDIV
	LAC	.-1
	JMS	.SET
.AN	CAL	0	/SINGLE RDIV
	LAC*	.AN
	JMS	.CB
	JMS	.FRE
	122104		/RD
	JMS	.CI	/GEN DIV
	JMP*	.AN
/
	/.CB -GET ARG ADDRESS
.CB	CAL	0
	DAC	CE14	/ARG ADD.
	SPA!STL		/NOT INDIR.
	LAC*	CE14	/INDIRECT
	DAC	CE14
	LAW	-3	/ADV. EXIT
	TAD	.CB	/OVER ARG
	DAC	T1	/IN SUBR
	ISZ*	T1	/CALL
	LAC*	T1
	DAC	ERA	/ERR ADDRESS
	LAC	CE14
	JMP*	.CB
/
	/ DIVIDE ROUTINE-.CI
.CI	XX
	LAC	.AC	/LO DIVISOR
	STL!CMA
	TAD	CN03	/1
	DAC	CI01	/D2'=1-D2
	DAC	CI02
	GLK		/L=0 IF.AC=0
	TAD	.AB	/D1'=D1+1, 
	DAC	CI03	/D=D1'-D2'
	AND	(600000	/UNNORM DIV
	SNA!CLL
	JMP	DIVF
	LAC	CE03
	LMQ
	ALS	20
	AND	(600000	/PUT 2 BITS
	DAC	.A4	/IN .A4
	LAC	CE02
	LRS	2
	JMS	DIVR	/HI DIVISION
	DAC	.AC	/R1=N-D1'*Q1
	LACQ
	DAC	.AB	/Q1
	MUL		/Q1*D2'
CI01	CAL	0
	TAD	.AC	/R+Q1*D2'
	DAC	.AC
	LACQ		/GET LO PART
	TAD	.A4	/+ 2 LO BITS
	LMQ
	GLK
	TAD	.AC	/NEW NUM.
	LRS	2	/AVOID OVF
	JMS	DIVR	/Q2
	DAC	.A4	/R2
	LACQ
	DAC	.AC	/Q2
	MUL
CI02	CAL	0	/Q2*D2'
	TAD	.A4	/R2+Q2*D2'
	LRS	2	/AVOID OVF
	JMS	DIVR	/Q3
	641604		/CLA+LLS4
	DAC	T1
	LACQ		/SHIFTED Q3
	DAC	.A4
	LAC	.AC
	LMQ		/Q2 TO MQ
	641602		/CLA+LLS2
	TAD	.AB
	DAC	.AB	/HI QUOTIENT
	LACQ
	TAD	T1	/Q2+Q3
	DAC	.AC	/LO QUOTIENT
	SZL!CLL
	ISZ	.AB
	LAC	(377776	/BIAS
	JMS	ADN	/+ .AA EXT
	CMA
	DAC	.AAG
	LAC	.AA
	CMA
	DAC	.AA
	LAC	.CE	/FORM SIGN
	DAC	CE05
	JMS	.NORD	/NORM-RD-OV
	JMP*	.CI
DIVF	LAW	3	/0 OR UNORM
	JMP	.OV+1	/DIVISOR
DIVR	CAL	0
	DIV
CI03	CAL	0
	JMP*	DIVR
/
	/ CONSTANTS-WORKING STORE
.AAG	0	/.AA EXTEN
.AA	0	/FAC
.AB	0
.AC	0
.A4	0	/GUARD WORD
CE01	0	/HAC
CE02	0
CE03	0
.FS	0	/FAC SIGN
.HS	0	/HAC SIGN
.CE	0	/COMBINED SIGN
CE14	0	/OPERAND ADDRESS
.T1	0	/TEMP STORE
	0
	0
REAL02	400
REAL03	777
REAL04	777000
REAL05	377400
CN01	400000
CN02	377777
CN03	1
.HX=CE01
CEHS=.HS
CE05=.FS
TP1=.T1
/
	/MULT ROUTINE-.CA
.CA	XX
	LAC	.AC
	DAC	CA01
	DAC	CA02
	LAC	.AB
	DAC	CA03
	DAC	CA04
	CLL
	LAC	CE03
	MUL		/LO*LO
CA01	CAL	0
	DAC	.A4
	LAC	CE02
	MUL		/HI*HI
CA03	CAL	0
	DAC	.AB
	LACQ
	DAC	.AC
	LAC	CE02
	MUL		/HIH*LOF
CA02	CAL	0
	JMS	.ACU
	LAC	CE03
	MUL		/LOH*HIF
CA04	CAL	0
	JMS	.ACU
	LAC	(400001	/BIAS=400001
	JMS	ADN	/+ .AA EXT
	LAC	.CE	/FORM SIGN
	DAC	CE05
	JMS	.NORD	/NORM-RD-OV
	JMP*	.CA
.ACU	CAL	0
	TAD	.AC
	DAC	.AC
	SZL!CLL
	ISZ	.AB
	LACQ
	TAD	.A4
	DAC	.A4
	SZL!CLL
	ISZ	.AC
	SKP
	ISZ	.AB
	JMP*	.ACU
T1=.ACU
/
	/ ADD ROUTINE -.CC
.CC	XX
	LAC	CE01	/HX
	CMA!STL
	TAD	.AA	/FX
	SNL
	JMP	CC01	/FX > HX
	CMA
	DAC	T1	/EX DIF
	JMS	.XSE	/EXCH SIGN&EX
CC02	DZM	.A4
CC04	LAC	T1
	SNA!CLL
	JMP	CC11	/EX DIF=0
	TAD	M22
	SZL!STL
	JMP	CC03	/DIF > 21
	TAD	(LRS+22	/FORM SHIFT
	JMS	CC06
CC11	LAC	.CE
	RAR		/SIGN TO L
	SZL!CLL		/SIGNS=?
	JMS	CC12	/COMP. FAC
	LAC	.AC	/ADD PARTS
	TAD	CE03
	DAC	.AC
	GLK
	TAD	.AB
	TAD	CE02
	DAC	.AB
	CML!GLK
	AND	.CE
	SZA
	JMP	CC13	/CHANGE SIGN
CC14	DZM	CE01
	JMP*	.CC	/EXIT ADD
CC01	TAD	CN03	/FX > HX
	DAC	T1
	JMS	.XFR	/EXCH. FRACS
	JMP	CC02
CC03	DAC	T1	/DIF=DIF-22
	TAD	M22
	SNL!CLL
	JMP	CC05	/EX DIF > 43
	LAC	(LRS+22
	JMS	CC06
	JMP	CC04
CC05	JMS	.XFR	/HAC IS ANS
	JMP	CC14
CC06	CAL	0	/SHIFT < 22
	DAC	CC07
	DAC	CC10
	LAC	.A4
	LMQ
	LAC	.AC
CC07	XX
	DAC	.AC
	LACQ
	DAC	.A4
	CLQ
	LAC	.AB
CC10	XX
	DAC	.AB
	LACQ
	XOR	.AC
	DAC	.AC
	JMP*	CC06
CC12	CAL	0	/COMP. FAC
	LAC	.A4
	CMA!CLL
	TAD	CN03
	DAC	.A4
	LAC	.AC
	CMA!SZL!CLL
	TAD	CN03
	DAC	.AC
	LAC	.AB
	CMA!SZL!CLL
	TAD	CN03
	DAC	.AB
	CLL
	JMP*	CC12
CC13	ISZ	CE05	/CHANGE SIGN
	JMS	CC12	/COMP. FAC
	JMP	CC14
/
	/.XFR-EXCHANGE FRACTIONS
.XFR	CAL	0
	LAC	.AB
	DAC	T2
	LAC	CE02
	DAC	.AB
	LAC	T2
	DAC	CE02
	LAC	.AC
	DAC	T2
	LAC	CE03
	DAC	.AC
	LAC	T2
	DAC	CE03
	JMP*	.XFR
/
	/.XSE-EXCHANGE SIGN & EXP
.XSE	CAL	0
	LAC	CE05
	DAC	T2
	LAC	CEHS
	DAC	CE05
	LAC	T2
	DAC	CEHS
	LAC	.AA
	DAC	T2
	LAC	CE01
	DAC	.AA
	LAC	T2
	DAC	CE01
	JMP*	.XSE
/
.NORD	CAL	0
	JMS	.CD	/NORMALIZE
	JMS	.CH	/ROUND
	JMS	.ZRSN	/PACK SIGN
	SNL		/SKIP IF 0
	JMS	OUTS	/OV-UN TEST
	LAC	.AB
	JMP*	.NORD
/
	/.CD-NORMALIZE
.CD	CAL	0
CD04	LAC	.AC
	LMQ
	LAC	.AB
	SPA!CLL
	JMP	CD01	/ARITH OV
	SNA
	JMP	CD02	/.AB=0
	NORM
	DAC	.AB
	LACQ
	DAC	.AC
	LACS		/-44+SHIFTS
	DAC	CD07
	TAD	M35	/SHIFTS-1
	CMA!CLL		/-SHIFTS
	SZA
	JMS	ADN	/.AA-SHIFTS
	LAC	CD07
	TAD	(LRS+44	/FORMS LLS
	DAC	CD07
	LAC	.A4
	LMQ
	CLA!CLL
CD07	LLS		/SHIFT FRAC
	XOR	.AC
	DAC	.AC
	LACQ
	DAC	.A4
CD06	JMP*	.CD	/EXIT
CD01	RCR		/ARITH OV
	DAC	.AB	/SHIFT R1
	LAC	.AC
	RAR
	DAC	.AC
	LAC	.A4
	RAR
	DAC	.A4
	ISZ	.AA	/ADD 1 TO EX
	JMP*	.CD
	ISZ	.AAG
M1	LAW	-1	/NULL COMMAND
	JMP*	.CD
CD02	LAW	-22	/HI FRAC=0
	JMS	ADN
	LAC	.AC
	SZA		/AC=0?
	JMP	CD05
	SAD	.A4	/.AC=.A4?
	JMP	CD06	/ZERO RESULT
CD05	DAC	.AB	/MOVE UP
	LAC	.A4	/FRACTION
	DZM	.A4	/PARTS
	DAC	.AC
	JMP	CD04
/
	/.CH-ROUND
.RB	0		/0= ROUND
			/>0 NO ROUND
.CH	CAL	0
	LAC	.RB
	DZM	.RB
	SZA
	JMP*	.CH
	LAC	.A4	/=0,ROUND
	RAL		/A0 TO LINK
	GLK
	TAD	.AC
	DAC	.AC
	GLK
	TAD	.AB
	DAC	.AB
	SMA
	JMP	CH02
	RAR		/RD UP OV
	DAC	.AB
	ISZ	.AA	/ADD 1 TO EX
	JMP	.+3
	ISZ	.AAG
M35	LAW	-35	/NULL COMMAND
CH02	DZM	.A4
	JMP*	.CH
/
	/OVERFLOW-UNDERFLOW TEST
OUTS	CAL	0
	LAC	CE01
	JMS	ADN
	SAD	M1
	JMP*	OUTS	/OK IF -1
	SMA
	JMP	.OV	/OV IF +
.UN	LAW	2	/UN IF < -1
	JMS	ERP
	CLA
	JMS	.AW	/FLOAT 0
	JMP*	OUTS
.OV	LAW	1	/OTS 1
	JMS	ERP
	JMP	.	/IDLE
/
	/ADN- ADD TO EXPONENT
ADN	CAL	0
	TAD	.AA
	DAC	.AA
	GLK
	TAD	.AAG
	TAD	M1
	DAC	.AAG
	JMP*	ADN
/
	/.SET-DOUBLE PREC SETUP
.SET	CAL	0
	DAC*	.SET
	ISZ	.SET
	JMP*	.SET
/
	/.FRE-.FDB ARG TO HAC
	/.CG-SIGN CONTROL
.FRE	CAL	0
	LAC*	.FRE
	DAC	ERN
	LAC	.SET
	DZM	.SET
	SZA
	JMP	.FDB
	LAC*	CE14	/SINGLE PREC
	AND	REAL04	/EXTRACT LO
	DAC	CE03
	LAC*	CE14
	AND	REAL03	/EXTRACT EX
	XOR	REAL02	/CHANGE SIGN
	TAD	REAL05	/BIAS EX
	DAC	CE01
	ISZ	CE14
	LAC*	CE14
.CG	SAD	CE03	/FRAC = ?
	SZA!CLL		/YES, =0?
	SKP!CLL
	DZM	CE01
	TAD	CN01	/SIGN TO L
	AND	CN02	/ABS VALUE
	DAC	CE02	/OF FRAC
	GLK
	DAC	CEHS	/SAVE SIGN
	XOR	CE05
	DAC	.CE	/JOINT SIGN
	DZM	.AAG	/0 TO .AA EX
	LAC	.AB	/ABS VALUE
	AND	CN02	/OF FAC
	DAC	.AB
	ISZ	.FRE
	JMP*	.FRE
.FDB	LAC*	CE14	/DOUBLE PREC
	XOR	CN01	/ADD BIAS
	DAC	CE01
	ISZ	CE14
	LAC*	CE14
	DAC	CE02
	ISZ	CE14
	LAC*	CE14
	DAC	CE03
	LAC	CE02
	JMP	.CG
/
	/.BA-NEGATE FAC
.BA	CAL	0
	ISZ	CE05
	JMS	.ZRSN
	JMP*	.BA
T2=.BA
/
	/.AW-INTEGER T0 FLOAT
	/INTEGER IN A
.AW	CAL	0
	DZM	CE05	/SET SIGN +
	DZM	.AC	/0 TO LOW
	DZM	.A4	/FRACS
	SMA
	JMP	AW01
	CMA		/2'S COMPL
	TAD	CN03
	ISZ	CE05	/SET SIGN -
AW01	DAC	.AB
	LAC	AW02	/FORM EXP
	DAC	.AA
	JMS	.CD	/NORM
	JMS	.ZRSN	/PACK SIGN
	JMP*	.AW
AW02	400021
M22=CD02
/
	/.AX-FLOAT TO INTEGER
/IF I>18 BITS,RIGHTMOST 18 BITS GIVEN &
/OTS 0.  -2**17 IS CONVERTED
.AX	CAL	0
	JMS	.AP	/SAVE FAC
		TP1
	LAC	TP1	/UNBIAS EXP
	TAD	M22	/FORM EXDEL
	LRSS		/SIGN TO L
	SNA!CLC		/EXDEL=0 ?
	LAC	.AC	/YES
	SMA!CLA		/.AC + ?
	LAC	.AB	/YES
	SAD	(600000
	JMP	AX02	/= -2**17
AX01	SZL		/EXDEL - ?
	JMP	AX02
	LAC	.AX
	DAC	ERA
	ISZ	ERA
	LAC	(77777
	DAC	ERN
AT	LAW	0	/OTS 0
	JMS	ERP	/INTEGER OV
AX02	JMS	.AG	/LD 2**35
		TWO35	/ARG TO HAC
	LAC	TP1+1	/SIGN OF ARG
	SPA
	ISZ	.AA	/2**36 IF -
	JMS	.CC	/ADD HAC
	JMS	.CD	/NORMALIZE
	JMS	.AO	/RESTORE FAC
		TP1	/.AC TO CE03
			/.AB IN A
	SPA!CLA		/ARG - ?
	LAC	.A4	/YES
	SZA!CLA		/RESIDUE 0 ?
	ISZ	CE03	/NO,RD UP
	LAC	CE03	/= INTEGER
	JMP*	.AX
TWO35	43
	200000
/
/ERROR REPORT ROUTINE
ERP	XX
	DAC	ERC
	LAC	ERN
	LRSS+11		/SHIFT R9
	TAD	AT
	DAC	ERN
	LLS+1011	/CLEAR A, L9
	TAD	AT
	DAC	ERN+1
	LAC	ERA
	AND	(77777	/SCREEN ADDR
	DAC	ERA
	TAD	(-2
	JMS*	.SP	/PRINT MES.
ERA	0
ERN	0
	0
	LAW	40
	LAW	40
	LAW	100
	LAW	40
	JMS*	.ER
ERC	400000		/OTS CODE
	JMP*	ERP
.RE=ERP
/
	.END