/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