/COPYRIGHT 1970, DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
	/EDIT 07P  10-14-70
/	INCLUDES UNDERFLOW-OVERFLOW GUARD
	/PDP15 VERSION OF REAL DERIVED FROM EDIT 6 VERSION OF
	/OF REAL FOR THE PDP9
       .TITLE REAL	 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
	.GLOBL REAL,.OVUDF,RELNON,.DZERO
REAL=.
RELNON=.
TCA=CMA!IAC
/INTERNAL GLOBLS CALLED BY DOUBLE
	.GLOBL CE01,CE02,CE03
	.IFDEF TIME%
	.GLOBL TIMON,TIMOFF
	.ENDC
/CONDITIONAL CODE...WAD...JULY...69
/
/	    CONTENTS
/
/	    .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 16
	.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 16
	.ENDC
       JMP*   .AG	         /EXIT
AG01	CAL	0	/(ADDR OF REAL N0)
       .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 17
	.ENDC
	LAC* .AH		/IN LINE .CB
	ISZ .AH
	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		/POSITIVE 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 17
	.ENDC
       JMP*   .AH	         /EXIT
OVERF	LAC REAL01	/MAKE .OVRUND POSITIVE (777)
UNDERF	DAC .OVUDF
	DZM* AH01	/STORE 0.0 IN BOTH CASES
	ISZ AH01		/BUMP POINTER
	DZM* AH01
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 17
	.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%	/WAD....JULY 69
	JMS* TIMON
	.DSA 20
	.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 20
	.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 21
	.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 21
	.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%	/WAD....JULY 69
	JMS* TIMON
	.DSA 22
	.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 22
	.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 23
	.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 23
	.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 24
	.ENDC
       JMS    .BA	         /NEGATE SUBTRAHEND
       JMS    .AI	         /ADD REAL
       .DSA   AM01+400000    / (MINUEND - 0U+TRAHEND)
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 24
	.ENDC
       JMP*   .AM	         /EXIT
       .EJECT
/		         REVERSE DIVIDE REAL (.AN)
/	    CALLING SEQUENCE
/      JMS   .AN	         SUBR CALL (DIVISOR IN FLOATING ACC)	 L
/      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 25
	.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 25
	.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 26
	.ENDC
       DAC    .CE	         /PUT AWAY FOR SIGN
       SPA
       TCA		/TWOS COMP IF NEGATIVE
       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 26
	.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 27
	.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 27
	.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
AX06   LAC    .AB
	AND	CN02	/ *** DDS NOV68 ***
      JMP     AX05
AX02	    777757         /CONSTANT (-17)
       .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
       .EJECT
/		     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 30
	.ENDC
       LAC    .AB	         /GET SIGN WORD
       SZA	         /DON@T BOTHER IF ZERO
       XOR    CN01	         /(400000) CHANGE SIGN
       DAC    .AB
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 30
	.ENDC
       JMP*   .BA	         /EXIT
       .EJECT
/		     GENERAL FLOATING MULTIPLY (.CA)
/	    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	         /EXIT ENTRY
	.IFDEF TIME%
	JMS* TIMON
	.DSA 31
	.ENDC
       LAC    .AA	         /ADD EXPONENT OF MULTIPLIER, MULTIPLICAND
       TAD    CE01
       DAC    .AA	         /AS PRODUCT EXPONENT
       JMS    .CG	         /STRIP SIGN
       LAC    .AC	         /STORE-ICAND
       DZM    .AC	         /AND CLEAR
       DAC    CE11
       LAC    .AB
       DZM    .AB
       SNA
       JMP    CA01	         /ZERO EXIT
       DAC    CE10
       DZM    CE12	         /CLEAR CARRY EXTENSIONS
       DZM    CE04
CA06   LAC    CE10	         /SHIFT THREE
       RCR	         /WORD-ICAND
       DAC    CE10	         /ONE
       LAC    CE11	         /BIT
       RAR	         /RIGHT
       DAC    CE11
       LAC    CE12
       RAR
       DAC    CE12
       LAC    CE03	         /SHIFT TWO
       RCL	         /WORD MULTIPLIER
       DAC    CE03	         /ONE
       LAC    CE02	         /BIT
       RAL	         /LEFT
       DAC    CE02
       SNA	         /IS MULTIPLIER ZERO
       JMP    CA07	         /MAYBE
       SMA!CLL	         /NO-IS MULTIPLIER BIT 0 SET
       JMP    CA06	         /NO-CYCLE
       LAC    CE04	         /YES-ADD MULTIPLICAND TO PRODUCT
       TAD    CE12
       DAC    CE04
       GLK
       TAD    .AC
       TAD    CE11
       DAC    .AC
       GLK
       TAD    CE10
       TAD    .AB
       DAC    .AB
       JMP    CA06	         /CYCLE
CA07   LAC    CE03	         /IS MULTIPLIER ZERO
       SZA	         /YES
       JMP    CA06	         /NO-CYCLE
CA01   JMS    .CD	         /NORMALIZE
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 31
	.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 32
	.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
	TAD CE01		/ADDEND-AUGEND-1
       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, IS DELTA .GE. A FULL WORD
       TAD    CN05	         / (18)
       SPA
       JMP    CC09	         /YES-EXCHANGE WORDS
CC01   LAC    CE02	         /SHIFT ADDEND TO RIGHT DELTA + 1 TIMES
       RCR
       DAC    CE02
       LAC    CE03
       RAR
       DAC    CE03
       ISZ    CE10
       JMP    CC01	         /CYCLE SHIFT
       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
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 32
	.ENDC
       JMP*   .CC	         /EXIT
CC09   DAC    CE10	         /STORE NEW DELTA
       LAC    CE02	         /STORE M.S. IN L.S.
       DAC    CE03
       DZM    CE02	         /PLACE ZERO IN M.S.
       JMP    CC01	         /BACK TO SHIFT (DELTA)
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)
/	    CALLING SEQUENCE
/      JMS*   (.CD) 	SUBR CALL (VALUE IN FLOATING ACC)
/      NEXT   INSTRUCTION	SUBR RETURN (VALUE NORMALIZED IN FLOAT ACC
/
.CD    CAL    0	         /ENTRY EXIT
	.IFDEF TIME%
	JMS* TIMON
	.DSA 33
	.ENDC
       LAC    .AB	         /IF .AB AND .AC = ZERO
       SAD    .AC
       SZA
       JMP    CD01
       DZM    .AA	         /CLEAR EXP AND SIGN
       DZM    .CE
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 33
	.ENDC
       JMP*   .CD	         /EXIT
CD01   RCL	         /IS BIT 1 OF .AB SET
       SPA!CLA!CMA		/WAD....69
	.IFUND TIME%
	JMP* .CD
	.ENDC
	.IFDEF TIME%
	JMP CD01-3	/YES-FLOATING ACC IS NORMALIZED, EXIT
	.ENDC
       TAD    .AA
       DAC    .AA	         /AND SHIFT MANTISSA 1 BIT LEFT
       LAC    .AC
       RCL
       DAC    .AC
       LAC    .AB
       RAL
       DAC    .AB
       JMP    CD01	         /CYCLE
       .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 34
	.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 34
	.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 35
	.ENDC
       LAC    .AB	         /KEEP SIGN OF .AB
       AND    CN01
       DAC    CE05	         /STORE IN CE05
	XOR	CE02
	AND	CN01
	DAC	.CE
       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 35
	.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 36
	.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 36
	.ENDC
       JMP*   .CH	         /EXIT
       .EJECT
/		     GENERAL FLOATING DIVIDE (.CI)
/	    CALLING SEQUENCE
/      JMS*   (.CI) 	SUBR CALL (DIVIDEND IN HELD,DIVISOR IN ACC
/	    -34/-44	NO OF BITS TO GENERATE
/	    400/1 	LEAST SIGNIFICANT QUOTIENT BIT
/      NEXT   INSTRUCTION	SUBR RETURN (QUOTIENT IN ACC,SIGN IN CE06)
/
.CI    CAL    0	         /ENTRY-EXIT
	.IFDEF TIME%
	JMS* TIMON
	.DSA 37
	.ENDC
       LAC*   .CI	         /GET NO. OF BITS
       DAC    CE10	         /STORE AS CNTR
       ISZ    .CI	         /BUMP FOR MASK
       JMS    .CG	         /SIGN CONTROL
       LAC    .AC	         /NEGATE DIVISOR AND STORE IN TEMP
       DZM    .AC	         /CLEAR ACC FOR QUOTIENT
       CLL!TCA
       DAC    CE11
       LAC    .AB
       CMA!SZL
	IAC
       DZM    .AB
       SNA	         /TEST FOR ZERO DIVISOR
       JMP    CI09	         /ANSWER IS ZERO
       DAC    CE12
       LAC    CE02	         /TEST FOR ZERO DIVIDEND
       SNA
       JMP    CI05	         /ANSWER IS ZERO
       LAC    .AA	         /DETERMINE ANSWER EXP
       TCA
       TAD    CE01
       DAC    .AA	         /STORE EXP
CI01   LAC    .AC	         /SHIFT QUOTIENT 1 BIT LEFT
       RCL
       DAC    .AC
       LAC    .AB
       RAL
       SPA	         /IF NEGATIVE, PUSH BACK AND EXIT
       JMP    CI04
       DAC    .AB
       LAC    CE11	         /TRY SUBTRACTING DIVISOR
       TAD    CE03	         /FROM DIVIDEND
       DAC    CE14
       GLK
       TAD    CE12
       TAD    CE02
       SMA
       JMP    CI02	         /IF NEGATIVE, DO NOT GENERATE
       LAC    CE03	         /A QUOTIENT BIT
CI03   RCL	         /SHIFT DIVIDEND 1 BIT LEFT
       DAC    CE03
       LAC    CE02
       RAL
       DAC    CE02
       ISZ    CE10	         /ALL BITS BEEN SHIFTED
       JMP    CI01	         /NO-CYCLE
CI05   JMS    .CD	         /YES-NORMALIZE
CI08   ISZ    .CI	         /BUMP FOR EXIT
	.IFDEF TIME%
	JMS* TIMOFF
	.DSA 37
	.ENDC
       JMP*   .CI	         /EXIT
CI02   DAC    CE02	         /STORE POSITIVE DIFF AS DIVIDEND
       LAC*   .CI	         /GET L.S. QUOTIENT BIT
       XOR    .AC	         /ADD INTO L.S. QUOTIENT
       DAC    .AC
       LAC    CE14	         /GET .AC DIFF
       JMP    CI03	         /BACK TO SHIFT
CI04   RCR	         /SHIFT QUOTIENT 1 BIT RIGHT
       LAC    .AC
       RAR
       DAC    .AC
       ISZ    .AA	         /BUMP EXPONENT
       JMP    CI08
       JMP    CI08	         /GO TO EXIT
CI09	DAC .DZERO	/SET DIVIDE BY ZERO FLAG
	JMP CI05	/CONT. WITH ZERO RESULT
       .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		/OVERFLOW-UNDERFLOW FLAG
.DZERO	777777		/DIVIDE BY ZERO FLAG
       .END