/COPYRIGHT 1970, DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
	/EDIT 08P  10-14-70
	/INCLUDES UNDERFLOW-OVERFLOW GUARD
	/PDP15 VERSION OF RELEAE DERIVED FROM EDIT 7 VERSION OF
	/OF REAL FOR THE PDP9
       .TITLE REAL	 (EAE)SINGLE PRECISION FLOATING POINT ARITHMETIC PACKAGE
       .GLOBL .AG,.AH,.AI,.AJ,.AK,.AL,.AM,.AN,.AW,.AX,.AA,.AB,.AC
       .GLOBL .BA,.CA,.CB,.CC,.CD,.CF,.CG,.CH,.CI,.CE,CE01,CE02,CE03
	.GLOBL REAL,.OVUDF,RELEAE,.DZERO
REAL=.
RELEAE=.
TCA=CMA!IAC
/	DIRECT ASSIGNMENTS FOR EAE INSTRUCTIONS
DIV=640323
FRDIV=650323
LACQ=641002
LACS=641001
LLS=640600
LMQ=652000
LRS=640500
MUL=653122
NORM=640444
	.IFDEF TIME%
	.GLOBL TIMON,TIMOFF
	.ENDC
/CONDITIONAL CODE...WAD...JULY 69
/
/	    CONTENTS      (EAE)
/
/	    .AG	         LOAD REAL
/	    .AH	         STORE REAL
/	    .AI	         ADD REAL
/	    .AJ	         SUBTRACT REAL
/	    .AK	         MULTIPLY REAL
/	    .AL	         DIVIDE REAL
/	    .AM	         REVERSE SUBTRACT REAL
/	    .AN	         REVERSE DIVIDE REAL
/	    .AW	         FLOAT INTEGER TO FLOATING ACCUMULATOR
/	    .AX	         FIX FLOATING ACCUMULATOR TO INTEGER
/
/	      SHARED BY DOUBLE PRECISION PACKAGE
/
/	    .AA	         FLOATING ACCUMULATOR - EXPONENT
/	    .AB	         FLOATING ACCUMULATOR - SIGN, MOST SIGNIF
/	    .AC	         FLOATING ACCUMULATOR - LEAST SIGNIF
/	    .BA	         NEGATE FLOATING ACCUMULATOR
/	    .CA	         GENERAL FLOATING MULTIPLY
/	    .CC	         GENERAL FLOATING ADD
/	    .CD	         NORMALIZE FLOATING ACCUMULATOR
/	    .CF	         HOLD FLOATING ACCUMULATOR
/	    .CG	         SIGN CONTROL
/	    .CH	         HALF ADJUST (ROUND) AND INSERT SIGN
/	    .CI	         GENERAL FLOATING DIVIDE
       .EJECT
/		 LOAD REAL (.AG)
/	    CALLING SEQUENCE
/      JMS*   (.AG) 	SUBR CALL
/      CAL/XCT ADDR 	ADDR OF REAL NUMBER (XCT IF INDIRECT)
/      NEXT   INSTRUCTION	SUBR RETURN (NUMBER IN FLOATING ACC)
/
.AG    CAL    0	         /ENTRY-EXIT
	.IFDEF TIME%	/WAD....JULY 69
	JMS* TIMON
	.DSA 40
	.ENDC
	LAC* .AG		/IN LINE .CB
	ISZ .AG
	DAC AG01
	SPA
	LAC* AG01
	DAC AG01		/WAD....JULY 69
       LAC*   AG01	         /GET L.S,EXP WORD
       AND    REAL04         /(777000) KEEP LEAST SIGNIF
       DAC    .AC	         /STORE
       LAC*   AG01	         /GET EXP
       AND    REAL01         /(000777)
       XOR    REAL02         /SET BIT 0-8 SAME AS BIT 9  (000400)
       TAD    REAL03         / (777400)
       DAC    .AA	         /STORE
       ISZ    AG01	         /BUMP ADDR TO GET M.S.
       LAC*   AG01	         /STORE  MOST SIGNIF AS IS
       DAC    .AB
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 40
	.ENDC
       JMP*   .AG	         /EXIT
AG01	CAL 0		/(ADDR OF REAL N0)-DIR. ASSIG. TO GLOBAL REAL
       .EJECT
/		         STORE REAL (.AH)
/	    CALLING SEQUENCE
/      JMS*   (.AH) 	SUBR CALL (NUMBER IN FLOATING ACC)
/      CAL/XCT ADDR 	ADDR TO STORE INTO (XCT IF INDIRECT)
/      NEXT   INSTRUCTION	SUBR RETURN
/
.AH    CAL    0	         /ENTRY-EXIT
	.IFDEF TIME%	/WAD...JULY 69
	JMS* TIMON
	.DSA 41
	.ENDC
	LAC* .AH
	ISZ .AH		/IN LINE .CB
	DAC AH01
	SPA
	LAC* AH01
	DAC AH01		/WAD...JULY 69
/	CHECK FOR UNDERFLOW AND OVERFLOW
/	THIS MEANS .AA > 377 OR .AA <-377
/	IF UNDERFLOW SET .OVUDF TO NEGATIVE
/	IF OVERFLOW SET .OVUDF TO POSITIVE (777)
/	DEFAULT FOR .OVUDF IS ZERO
/	STORE 0.0 IN BOTH CASES
	LAC .AA		/GET EXP
	TAD REAL03	/(-400)
	SMA		/POSTIVE OR ZERO IF OVERFLOW
	JMP OVERF
	TAD REAL01	/(777)
	SPA		/NEGATIVE IF UNDERFLOW
	JMP UNDERF
       LAC    .AA	         /GET EXP
       AND    REAL01         /(000777)
       DAC AG01	         /STORE EXP
       LAC    .AC	         /GET L.S.
       AND    REAL04         / (777000)
       TAD AG01	         /MERGE WITH EXP
       DAC*   AH01	         /STORE L.S., EXP
       ISZ    AH01	         /BUMP TO M.S.
       LAC    .AB	         /GET M.S.
       DAC*   AH01	         /STORE AS IS
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 41
	.ENDC
       JMP*   .AH	         /EXIT
OVERF	LAC REAL01	/MAKE .OVUDF POSITIVE (777)
UNDERF	DAC .OVUDF
	DZM* AH01	/STORE 0.0 IN BOTH CASES
	ISZ AH01		/BUMP POINTER
	DZM* AH01
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 41
	.ENDC
	JMP* .AH		/EXIT
AH01	CAL 0		/ADDR OF ARG
       .EJECT
/		         ADD REAL  (.AI)
/	    CALLING SEQUENCE
/      JMS*   (.AI) 	SUBR CALL (AUGEND IN FLOATING ACC)
/      CAL/XCT ADDR 	ADDR OF ADDEND (XCT IF INDIRECT)
/      NEXT   INSTRUCTION	SUBR RETURN (SUM IN FLOATING ACC)
/
.AI    CAL    0	         /ENTRY-EXIT
	.IFDEF TIME%
	JMS* TIMON
	.DSA 42
	.ENDC
	LAC* .AI		/ADDEND TO HLD AC
	DAC AI01
	SPA
	LAC* AI01		/ONE MORE LEVEL
	DAC AI01		/IF INDIRECT
	ISZ .AI		/BUMP EXIT
	LAC* AI01		/ADDEND TO HLD AC
	AND REAL04	/777000 STORE LST
	DAC CE03		/SIGNF.
	LAC* AI01		/GET EXP
	AND REAL01	/000777
	XOR REAL02	/000400 BITS 0-8=9
	TAD REAL03	/777400
	DAC CE01		/STORE
	ISZ AI01		/BUMP ADDR TO GET
	LAC* AI01		/MS. STORE AS IS
	DAC CE02		/WAD...JULY 69
       JMS    .CC	         /FLOATING ADD
	    32	         /26 MAX SHIFT
       JMS    .CH	         /ROUND
	    400
	    777000
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 42
	.ENDC
       JMP*   .AI	         /EXIT
AI01	CAL 0		/ADDR OF ADDEND
       .EJECT
/		         SUBTRACT REAL  (.AJ)
/	    CALLING SEQUENCE
/      JMS*   (.AJ) 	SUBR CALL (MINUEND IN FLOATING ACC)
/      CAL/XCT ADDR 	ADDR OF SUBTRAHEND (XCT IF INDIRECT)
/      NEXT   INSTRUCTION	SUBR RETURN (DIFFERENCE IN FLOATING ACC)
/
.AJ    CAL    0	         /ENTRY EXIT
       JMS*    .CB	         / *** DDS DEC68 ***
AJ01   CAL    0	         /ADDR OF SUBTRAHEND
	.IFDEF TIME%
	JMS* TIMON
	.DSA 43
	.ENDC
       JMS    .BA	         /NEGATE MINUEND
       JMS    .AI	         /ADD REAL
       .DSA   AJ01+400000    / (-MINUEND + SUBTRAHEND)
       JMS    .BA	         /NEGATE RESULT (+MINUEND - SUBTRAHEND)
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 43
	.ENDC
       JMP*   .AJ	         /EXIT
       .EJECT
/		         MULTIPLY REAL (.AK)
/	    CALLING SEQUENCE
/      JMS*   (.AK) 	SUBR CALL (MULTIPLICAND IN FLOATING ACC
/      CAL/XCT ADDR 	ADDR OF MULTIPLIER (XCT IF INDIRECT
/      NEXT   INSTRUCTION	SUBR RETURN (PRODUCT IN FLOATING ACC)
/
.AK    CAL    0	         /ENTRY-EXIT
	.IFDEF TIME%
	JMS* TIMON
	.DSA 44
	.ENDC
	LAC* .AK
	DAC AK01
	SPA
	LAC* AK01		/ONE MORE LEVEL
	DAC AK01		/IF INDIRECT
	ISZ .AK		/BUMP EXIT
	LAC* AK01		/MULTIPLIER INTO
	AND REAL04	/HLD AC
	DAC CE03		/STORE LST SIGNF BITS
	LAC* AK01		/GET EXP
	AND REAL01	/000777
	XOR REAL02	/000400 BITS 0-8=9
	TAD REAL03	/777400
	DAC CE01		/STORE
	ISZ AK01		/GET MS AND
	LAC* AK01		/STORE AS IS
	DAC CE02		/WAD....JULY 69
       JMS    .CA	         /FLOATING MULTIPLY
       JMS    .CH	         /ROUND
	    400
	    777000
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 44
	.ENDC
       JMP*   .AK	         /EXIT
AK01	CAL 0		/ADDR OF MULTIPLIER
       .EJECT
/		         DIVIDE REAL (.AL)
/	    CALLING SEQUENCE
/      JMS*   (.AL) 	SUBR CALL (DIVIDEND IN FLOATING ACC)
/      CAL/XCT ADDR 	ADDR OF DIVISOR (XCT IF INDIRECT)
/      NEXT   INSTRUCTION	SUBR RETURN
/
.AL    CAL    0	         /ENTRY-EXIT
       JMS*    .CB	         / *** DDS DEC68 ***
AL01   CAL    0	         /ADDR OF DIVISOR
	.IFDEF TIME%
	JMS* TIMON
	.DSA 45
	.ENDC
       JMS    .CF	         /HOLD DIVIDEND
       JMS    .AG	         /LOAD REAL
       .DSA   AL01+400000    /(DIVIS69)
       JMS    .CI	         /FLOATING DIVIDE
       LAW    -34	         /28 BITS
	    400	         /QUOTIENT BIT
       JMS    .CH	         /ROUND
	    400
	    777000
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 45
	.ENDC
       JMP*   .AL
       .EJECT
/		         REVERSE SUBTRACT REAL (.AM)
/	    CALLING SEQUENCE
/      JMS*   (.AM) 	SUBR CALL (SUBTRAHEND IN FLOATING ACC)
/      CAL/XCT ADDR 	ADDR OF MINUEND (XCT IF INDIRECT)
/	NEXT INSTRUCTION	SUBR RETURN (DIFFERENCE IN FLOATING ACC)
/
.AM    CAL    0	         /ENTRY-EXIT
       JMS*    .CB	         / *** DDS DEC68 ***
AM01   CAL    0	         /ADDR OF MINUEND
	.IFDEF TIME%
	JMS* TIMON
	.DSA 46
	.ENDC
       JMS    .BA	         /NEGATE SUBTRAHEND
       JMS    .AI	         /ADD REAL
       .DSA   AM01+400000    / (MINUEND - 0U+TRAHEND)
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 46
	.ENDC
       JMP*   .AM	         /EXIT
       .EJECT
/		         REVERSE DIVIDE REAL (.AN)
/	    CALLING SEQUENCE
/      JMS*   .AN		SUBR CALL (DIVISOR IN FLOATING ACC)
/      CAL/XCT ADDR 	ADDR OF DIVIDEND (XCT IF INDIRECT)
/      NEXT   INSTRUCTION	SUBR RETURN (QUOTIENT IN FLOATING ACC)
/
.AN    CAL    0	         /ENTRY-EXIT
       JMS*    .CB	         / *** DDS DEC68 ***
AN01   CAL    0	         /ADDR OF DIVIDEND
	.IFDEF TIME%
	JMS* TIMON
	.DSA 47
	.ENDC
       JMS    .AH	         /STORE REAL
       .DSA   CE12	         / (DIVISOR TO TEMP)
       JMS    .AG	         /LOAD REAL
       .DSA   AN01+400000    / (DIVIDEND)
       JMS    .AL	         /DIVIDE REAL
       .DSA   CE12	         / (ADDR OF DIVISOR)
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 47
	.ENDC
       JMP*   .AN	         /EXIT
       .EJECT
/		     FLOAT INTEGER TO FLOATING ACCUMULATOR (.AW)
/	    CALLING SEQUENCE
/      JMS*   (.AW) 	SUBR CALL (INTEGER IN A-REG)
/      NEXT   INSTRUCTION	SUBR RETURN (INTEGER NORMALIZED IN FLT AC)
/
.AW    CAL    0	         /ENTRY-EXIT
	.IFDEF TIME%
	JMS* TIMON
	.DSA 50
	.ENDC
       DAC    .CE	         /PUT AWAY FOR SIGN
       SPA
       TCA
       SPA	         / TEST FOR CASE = 400000
       CLA
AW01   DAC    .AB	         /STORE IN SIGN WORD
       DZM    .AC	         /CLEAR L.S. WORD
       LAC    AW02	         /SET EXP TO 17
       DAC    .AA
       JMS    .CD	         /NORMALIZE THE INTEGER
       LAC    .CE	         /GET ORIG VALUE
       AND    CN01	         /KEEP ONLY SIGN
       XOR    .AB	         /PLACE IN SIGN WORD
       DAC    .AB
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 50
	.ENDC
       JMP*   .AW	         /EXIT
AW02	    21
       .EJECT
/		     FIX FLOATING ACC TO INTEGER IN A-REG (.AX)
/	    CALLING SEQUENCE
/      JMS*   (.AX) 	SUBR CALL (VALUE IN FLOATING ACC)
/      NEXT   INSTRUCTION	SUBR RETURN (INTEGER OF VALUE IN A-REG)
/
.AX    CAL    0	         /ENTRY-EXIT
	.IFDEF TIME%
	JMS* TIMON
	.DSA 51
	.ENDC
       LAC    .AB	         /GET SIGN WORD
       AND    CN01	         / (400000) KEEP SIGN ONLY
       DAC    CE14	         /STORE SIGN
       LAC    .AA	         /GET EXP
       SPA
       JMP    AX01	         /IF .LT. ZERO, SET A = ZERO AND SIGN
       TAD    AX02	         /(EXP-17)
       DAC    CE13	    /STORE NO. OF SHIFTS
       SNA
       JMP    AX06
       SMA	         /IF EXP WAS .GE. 17
       JMP    AX03	         / SET A = LARGEST AND SIGN
	LAC	.AB		/GET SIGN WORD
       AND    CN02	         /KEEP M.S.
AX04   RCR	         /SHIFT
       ISZ    CE13	         / AND TEST COUNTER
       JMP    AX04	         /  KEEP SHIFTING
AX05   XOR    CE14	         /SIGN THE RESULT
       SMA	         /IF NEGATIVE-TAKE TWOS COMP
	.IFUND TIME%
	JMP* .AX
	.ENDC
	.IFDEF TIME%
	JMP AX01-3	/OR EXIT
	.ENDC
       AND    CN02	         /STRIP PHONEY SIGN
       TCA	         /TWOS COMP
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 51
	.ENDC
       JMP*   .AX	         /EXIT
AX01   CLA	         /ACC WAS A FRACTION, ZERO AND SIGN
       JMP    AX05
AX03   LAC    CN02	         /ACC WAS .GT. LARGEST INTEGER
       JMP    AX05
AX02	    777757         /CONSTANT (-17)
AX06	LAC	.AB
	AND	CN02	/ *** DDS NOV68 ***
	JMP	AX05
       .EJECT
/		     FLOATING ACCUMULATOR (.AA,.AB,.AC)
/
/
.AA    CAL    0	         /EXPONENT (TWO'S COMP)
.AB    CAL    0	         /SIGN, MOST SIGNIF (SIGN MAGNITUDE)
.AC    CAL    0	         /LEAST SIGNIF
/		     NEGATE FLOATING ACCUMULATOR (.BA)
/	    CALLING SEQUENCE
/      JMS*   (.BA) 	SUBR CALL (VALUE IN FLOAT ACC)
/      NEXT   INSTRUCTION	SUBR RETURN ( -VALUE IN FLOAT ACC)
/
.BA    CAL    0	         /ENTRY EXIT
	.IFDEF TIME%
	JMS* TIMON
	.DSA 52
	.ENDC
       LAC    .AB	         /GET SIGN WORD
       SZA	         /DON'T BOTHER IF ZERO
       XOR    CN01	         /(400000) CHANGE SIGN
       DAC    .AB
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 52
	.ENDC
       JMP*   .BA	         /EXIT
       .EJECT
/		     GENERAL FLOATING MULTIPLY (.CA) (EAE)
/	    CALLING SEQUENCE
/      JMS*   (.CA) 	SUBR CALL (MULTIPLICAND IN FLOATING ACC)
/				(MULTIPLIER IN HELD ACC CE01-03)
/      NEXT   INSTRUCTION	SUBR RETURN (PRODUCT IN FLOATING ACC)
.CA	CAL	0
	.IFDEF TIME%
	JMS* TIMON
	.DSA 53
	.ENDC
	LAW	-1
	TAD	.AA		/COMPUTE PRODUCT EXPONENT AS
	TAD	CE01		/SUM OF MULTIPLIER AND
	DAC	.AA		/MULTIPLICAND EXPONENTS
	JMS	.CG		/COMPUTE PRODUCT SIGN AND
	LAC	.AC		/ABSOLUTIZE ARGUMENTS
	LMQ
	LAC .AB
	SNA!CLL
	JMP CA02
	LLS 1
	DAC	CA03		/SETUP CROSS-PRODUCT
	DAC	CA04		/MULTIPLICATIONS
	LACQ
	DAC CA01
	LAC CE03
	LMQ
	LAC	CE02
	SNA!CLL
	JMP	CA02		/MULTIPLIER=0
	LLS 1
	DAC CE02
	LACQ
	DAC CE03
	LAC CE02
	MUL			/A2*B1
CA01	.DSA	0
	DAC	.AC
	LACQ
	DAC	CE11
	LAC	CE03
	MUL			/A1*B2
CA03	.DSA	0
	DAC	.AB
	LACQ
	TAD	CE11
	GLK
	DZM	CE11		/DETERMINE CARRY INTO
	TAD	.AB		/LEAST SIGNIFICANT PORTION
	SZL!CLL			/OF PRODUCT
	ISZ	CE11
	TAD	.AC
	SZL!CLL
	ISZ	CE11
	DAC	.AC
	LAC	CE02
	MUL			/A1*B1
	.EJECT
CA04	.DSA	0
	DAC	.AB
	LACQ
	TAD	.AC		/DETERMINE CARRY INTO
	SZL!CLL			/MOST SIGNIFICANT PORTION
	ISZ	CE11		/OF PRODUCT
	LMQ
	LAC	CE11
	TAD	.AB		/IF CARRY OUT OF MOST
	SMA			/SIGNIFICANT PORTION,
	JMP	CA05		/REPLACE MISSING BIT,
	ISZ	.AA		/RE-NORMALIZE, AND
	NOP			/ADJUST PRODUCT EXPONENT
	LRS	1
CA05	DAC	.AB
	LACQ			/RETURN PRODUCT TO FLOATING AC
	DAC	.AC
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 53
	.ENDC
	JMP*	.CA		/EXIT
CA02	DZM	.CE		/COME HERE ON 0
	DZM	.AA		/MULTIPLIER AND
	DZM	.AB		/ACCUMULATORS
	DZM	.AC
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 53
	.ENDC
	JMP*	.CA		/EXIT
	.EJECT
/		     GENERAL FLOATING ADD (.CC)
/	    CALLING SEQUENCE
/      JMS*   (.CC) 	SUBR CALL (AUGEND IN FLOAT ACC, ADDEND IN
/	    32/42 	MAXIMUM SHIFT(26 S.P.,34 D.P.)/HELD ACC)
/      NEXT   INSTRUCTION	SUBR RETURN (SUM IN FLOAT ACC)
/
.CC    CAL    0	         /ENTRY EXIT
	.IFDEF TIME%
	JMS* TIMON
	.DSA 54
	.ENDC
       JMS    .CG	         /STRIP SIGNS
       LAC    CE02	         /TEST ADDEND FOR ZERO
       SNA
       JMP    CC04	         /YES-EXIT, ANSWER IS AUGEND
       LAC    .AB	         /TEST AUGEND FOR ZERO
       SNA
       JMP    CC08	         /YES-SWITCH ADDEND TO ANSWER, EXIT
CC07   LAC    .AA	         /DETERMINE EXP DELTA
       CMA	         / (ADDEND - AUGEND -1)
	TAD CE01
       SMA	         /SWITCH ADDEND, AUGEND IF POSITIVE
       JMP    CC05
       DAC    CE10	         /STORE EXP DELTA
       TAD*   .CC	         /IS THIS MORE THAN MAX ALLOWED
       SPA!CLA
       JMP    CC10	         /YES, EXIT WITH ANSWER = FLOATING ACC
	LAC	CE10		/NO, SCALE ADDEND TO BE
	TCA			/THE SAME AS THE AUGEND
	XOR	(640500		/GENERATE SHIFT COMMAND
	DAC	CC01
	LAC	CE03
	LMQ
	LAC	CE02
	CLL
CC01	LRS			/SHIFT ADD%ND TO RIGHT
	DAC	CE02		/DELTA+1 TIMES
	LACQ
	DAC	CE03
       LAC    .CE	         /IF SIGNS UNALIKE
       SMA	         /NEGATE ADDEND
       JMP    CC02	         /OR SKIP AROUND
       LAC    CE03
       CLL!TCA
       DAC    CE03
       LAC    CE02
       SZL!CMA
	IAC
	DAC	CE02
	.EJECT
CC02	LAC	.AB	/SHIFT AUGEND 1 BIT RIGHT
	RCR		/AND ADD ADDEND
       DAC    .AB
       LAC	.AC
       RAR
	CLL
       TAD    CE03
       DAC    .AC
       GLK
	TAD	.AB
	TAD	CE02
       DAC    .AB
       SMA	         /COMPLEMENT AND
       JMP    CC03	         /ADJUST SIGN OF
       LAC    .AC	         /ANSWER IF SUM
       TCA!CLL	         /WAS NEGATIVE
       DAC    .AC
       LAC    .AB
       SZL!CMA
	IAC
       DAC    .AB
       LAC    CN01	         /(400000) SET SIGN BIT
CC03   ISZ    .AA	         /BUMP EXPONENT
       NOP
CC10   XOR    CE05	         /DETERMINE ANSWER SIGN
       AND    CN01
       DAC    .CE	         /STORE ANS SIGN
       JMS    .CD	         /NORMALIZE
CC04   ISZ    .CC	         /BUMP EXIT
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 54
	.ENDC
       JMP*   .CC	         /EXIT
CC05   JMS    CC06	         /EXCHANGE AUGEND-ADDEND
       LAC    .CE	         /CHANGE SIGN
       XOR    CE05	         /OF NEW AUGEND
       DAC    CE05
       JMP    CC07	         /BACK TO GET DELTA
CC08   JMS    CC06	         /EXCHANGE AUGEND-ADDEND
       JMP    CC04	         /SET UP TO EXIT
CC06   CAL    0	         /ENTRY-EXIT (SWITCH AUGEND - ADDEND)
       LAC    .AC
       DAC    CE10
       LAC    CE03
       DAC    .AC
       LAC    CE10
       DAC    CE03
       LAC    .AB
       DAC    CE10
       LAC    CE02
       DAC    .AB
       LAC    CE10
       DAC    CE02
       LAC    .AA
       DAC    CE10
       LAC    CE01
       DAC    .AA
       LAC    CE10
       DAC    CE01
       JMP*   CC06
       .EJECT
/		     NORMALIZE FLOATING ACCUMULATOR (.CD)(EAE)
/	    CALLING SEQUENCE
/      JMS*   (.CD) 	SUBR CALL (VALUE IN FLOATING ACC)
/      NEXT   INSTRUCTION	SUBR RETURN (VALUE NORMALIZED IN FLOAT ACC
/
.CD	CAL	0
	.IFDEF TIME%
	JMS* TIMON
	.DSA 55
	.ENDC
	LAC	.AC
	SAD	.AB		/IF FLOATING ACCUMULATOR
	SZA!CLL			/IS ZERO, CLEAR EXPONENT
	JMP	CD01		/AND SIGN
	DZM	.AA		/AND EXIT IMMEDIATELY
	DZM	.CE
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 55
	.ENDC
	JMP*	.CD
CD01	LMQ			/SET UP FLOATING ACCUMULATOR
	LAC	.AB		/FOR NORMALIZATION
	AND CN01			/GET SIGN BIT...WAD...69
	DAC .ABSIG		/STORE FOR EXIT
	LAC .AB			/RELOAD...
	XOR .ABSIG		/STRIP SIGN IF NEG.
	CLL
	NORM
/	STORE AC IMMEDIATELY.  THEN LACS MUST FOLLOW
/	IN ORDER TO INSURE REENTRY WITH B/F MONITOR SYSTEM
	DAC .AB
	LACS
	TAD (-35
	CMA
	TAD .AA		/ADJUST EXPONENT BY AMOUNT
	DAC .AA		/OF NORMALIZATION
	LACQ
	DAC .AC
	LAC .AB		/RESTORE SIGN
	XOR .ABSIG
	DAC .AB
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 55
	.ENDC
	JMP*	.CD
       .EJECT
/		     HOLD FLOATING ACCUMULATOR (.CF)
/	    CALLING SEQUENCE
/      JMS*   (.CF) 	SUBR CALL (VALUE IN FLOATING ACC)
/      NEXT   INSTRUCTION	SUBR RETURN (VALUE IN HELD AND FLOAT ACC)
/
.CF    CAL    0
	.IFDEF TIME%
	JMS* TIMON
	.DSA 56
	.ENDC
       LAC    .AA	         /MOVE EXP
       DAC    CE01
       LAC    .AB	         /MOVE M.S.
       DAC    CE02
       LAC    .AC	         /MOVE L.S.
       DAC    CE03
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 56
	.ENDC
       JMP*   .CF	         /EXIT
       .EJECT
/		     SIGN CONTROL (STRIP SIGNS) (.CG)
/	    CALLING SEQUENCE
/      JMS*   (.CG) 	SUBR CALL (VALUES IN FLOAT AND HELD ACC)
/      NEXT   INSTRUCTION	SUBR RETURN (CE06= ANS SIGN,CE05=.AB SIGN)
/
.CG    CAL    0
	.IFDEF TIME%
	JMS* TIMON
	.DSA 57
	.ENDC
       LAC    .AB	         /KEEP SIGN OF .AB
       AND    CN01
       DAC    CE05	         /STORE IN CE05
	XOR CE02
	AND CN01
	DAC .CE		/STORE ANS SIGN
       LAC    .AB	         /STRIP SIGN OF .AB
       AND    CN02
       DAC    .AB
       LAC    CE02	         /STRIP SIGN OF CE02
       AND    CN02
       DAC    CE02
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 57
	.ENDC
       JMP*   .CG	         /EXIT
       .EJECT
/		     ROUND AND INSERT SIGN (.CH)
/	    CALLING SEQUENCE
/      JMS*   (.CH) 	SUBR CALL (VALUE IN FLOAT ACC,SIGN IN CE06
/	    400/1 	ROUNDOFF BIT
/	    777000/777776	EXTRACT MASK
/      NEXT   INSTRUCTION	SUBR RETURN (ROUNDED, SIGNED VALUE IN ACC)
/
.CH    CAL    0	         /ENTRY-EXIT
	.IFDEF TIME%
	JMS* TIMON
	.DSA 60
	.ENDC
       CLL
       LAC*   .CH	         /GET ROUNDOFF BIT
       ISZ    .CH
       TAD    .AC	         /ADD L.S.
       AND*   .CH	         /MASK SIGNIFICANT PORTION
       DAC    .AC	         /STORE L.S.
       GLK	         /GET OVFLW BIT
       TAD    .AB	         /ADD TO M.S.
       SMA	         /MORE OVFLW
       JMP    CH01	         /NO
       RCR	         /YES-NORMALIZE
       DAC    .AB	         /SAVE MOST SIGNIFICANT PART
       LAC    .AC	         /GET LEAST SIGNIFICANT
       RAR	         /BACK IT UP ONE
       AND*   .CH	         /MASK OFF POSSIBLE EXCESS
       DAC    .AC	         /PUT IT BACK
       LAC    .AB	         /RESTORE MOST SIGNIFICANT
       ISZ    .AA	         /BUMP EXPONENT
       JMP    CH01
CH01   XOR    .CE	         /SIGN WITH ANS SIGN
       DAC    .AB	         /STORE SIGN WORD
       ISZ    .CH	         /BUMP EXIT
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 60
	.ENDC
       JMP*   .CH	         /EXIT
       .EJECT
/GENERAL FLOATING DIVIDE (.CI)   --EAE VERSION-- 190 USEC.
/	CALLING SEQUENCE--
/	JMS*	.CI		ENTRY--DIVIDEND IN HAC, DIVISOR IN FAC.
/	NOP			DUMMY WORD--IGNORED.
/	NOP			DUMMY WORD--IGNORED.
/	NEXT INSTRUCTION		RETURN--ABS QUOTIENT IN FAC, SIGN IN .CE
/
.CI	CAL	0
	.IFDEF TIME%
	JMS* TIMON
	.DSA 61
	.ENDC
	ISZ	.CI		/INCREMENT RETURN ADDRESS TO PASS OVER
	ISZ	.CI		/DUMMY WORDS.
	JMS	.CG		/SIGN CONTROL--ANSWER SIGN T0 .CE AND
	LAC	.AC		/ABSOLUTIZE FAC AND HAC.
	RAL
	LAC	.AB		/SHIFT DIVISOR 1 LEFT TO MAKE SURE IT IS
	SNA			/GREATER THAN DIVIDEND AND STORE FOR
	JMP	CI08		/USE BY EAE DIVIDE INSTRUCTIONS.
	RAL			/(A1+A2)/(B1+B2)=(Q1+Q2)(1-Q3+Q3**2----)
	DAC	CI02		/WHERE-Q1=(A1+A2)/B1 FIRST 18 BITS
	DAC	CI03		/Q=2(A1+A2)/B1 SECOND 18 BITS
	DAC	CI04		/Q3=B2/B1
	LAC	.AA		/SUBTRACT DIVISOR EXPONENT FROM DIVIDEND
	TCA			/EXPONENT TO GET QUOTIENT EXPONENT.
	TAD	CE01
	DAC	.AA
	LAC	CE03		/LOAD AC+MQ WITH A1+A2
	LMQ
	LAC	CE02
	SNA!CLL
	JMP	CI01
	DIV			/GET FIRST 18 BITS OF (A1+A2)/B1
CI02	0
	DAC	CE11		/SAVE REMAINDER.
	LACQ			/GET Q1 FROM MQ.
	DAC	CI05		/SAVE Q1.
	LAC	CE11		/RELOAD AC WITH REMAINDER
	FRDIV			/GET SECOND 18 BITS OF (A1+A2)?B1.
CI03	0
	LACQ			/GET Q2 FROM MQ.
	DAC	CE11		/SAVE Q2.
	LAC	.AC		/CLEAR BIT0 OF B2 (IT WAS SHIFTED INTO B1)
	AND	CN02		/TO ENSURE THAT ITS SMALLER THAN B1.
	FRDIV			/GET B2/B1.
CI04	0
	LACQ			/GET Q3 FROM MQ.
	DAC	CI02		/SAVE Q3.
	SPA!CLA			/IF BIT0 OF Q3 IS SET, IT IS LARGE ENOUGH
	LAW	-1		/FOR THE Q3**2 TERM OF THE SERIES TO BE
	TAD	CI02		/SIGNIFICANT AND Q3 IS REDUCED BY ONE
	CLL			/TO COMPENSATE.
	MUL			/GET (Q1+Q2)*(Q3-Q3**2)=Q1*Q3 APPROX.
CI05	0
	DZM	CI02		/SAVE BIT0 OF Q1*Q3 AND THEN SHIFT AC+MQ
	SPA			/LEFT 1 TO ALIGN Q1*Q3 WITH Q2. SAVE
	ISZ	CI02		/Q1*Q3 IN CI03. Q1*Q3 NOW OCCUPIES
	LLS	1		/CI02(MS) AND CI03(LS).
	DAC	CI03
	LACQ			/ROUND CI03 PER HIGH	MQ BIT
	SPA
	ISZ	CI03
	SKP
	ISZ	CI02		/BUMP CI02 IF OVERFLOW FROM ROUNDING
	LAC CE11
	LMQ
	LAC	CI03		/SUBTRACT (CI02+CI03) FROM (Q1+Q2). FIRST
	SNA
	JMP CI07
	TCA			/SUBTRACT CI03 FROM Q2 AND PLACE ANSWER
				/IN MQ.
	STL
	TAD	CE11
	LMQ
	SZL			/BUMP CI02 IF A BORROW IS GENERATED FROM
	ISZ CI02			/MQ-CI03
CI07	LAC	CI02		/SUBTRACT CI02 FROM M1 AND LEAVE ANSWER
	TCA			/IN AC.
	TAD	CI05
	SMA!CLL			/IF RESULT IN AC+MQ HAS AC BIT0 SET,
	JMP	CI06		/NORMALIZE BY SHIFTING AC+MQ RIGHT
	LRS	1		/ONE AND BUMPING EXPOINET.
	ISZ	.AA
	NOP
CI06	DAC	.AB		/NORMAL EXIT--TRANSFER AC+MQ TO FAC. FAC
	LACQ			/IS UNROUNDED AND UNSIGNED
	DAC	.AC
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 61
	.ENDC
	JMP*	.CI
CI08	DAC .DZERO		/SET DIV. BY ZERO FLAG
CI01	DZM	.AA		/DEFAULT EXIT--CLEAR FAC AND SIGN. THIS
	DZM	.AB		/EXIT TAKEN IF EITHER DIVISOR OR DIVI-
	DZM	.AC		/DENT IS ZERO.
	DZM	.CE
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 61
	.ENDC
	JMP*	.CI
	.EJECT
/		 REAL STORAGE AND CONSTANTS
/
REAL01	    777
REAL02	    400
REAL03	    777400
REAL04	    777000
CN01	    400000
CN02	    377777
CN04	    2
CN05	    22
CE01   CAL    0	         /HELD ACC (1)
CE02   CAL    0	         /         (2)
CE03   CAL    0	         /         (3)
CE04   CAL    0
CE05   CAL    0	         /SIGN OF .AB
.CE    CAL    0	         /ANS SIGN	(.CE)
CE10   CAL    0
CE11   CAL    0
CE12   CAL    0
CE13   CAL    0
CE14   CAL    0
.OVUDF	0		/UNDERFLOW-OVERFLOW FLAG
.DZERO	777777		/DIVIDE BY ZERO FLAG
.ABSIG	0			/.AB SIGN STORAGE...WAD...69
       .END