.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,.MF .GLOBL .APH,.XCH,.SP,.RE /.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 DZM .A5 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 .XCH /EXC HAC&FAC 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 .XCH 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 M3 LAW -3 /ADV. EXIT TAD .CB /OVER ARG DAC T1 /IN SUBR ISZ* T1 /CALL LAC* T1 DAC ERA /ERROR 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 JMS FINI JMP* .CI DIVF LAW 3 /0 OR UNORM DIV JMP .OV+1 DIVR CAL 0 DIV CI03 CAL 0 JMP* DIVR / / CONSTANTS-WORKING STORE .MF 0 /MULTI-PREC FLAG .AAG 0 /.AA EXTEN .AA 0 /FAC .AB 0 .AC 0 .A4 0 /GUARD WORD .A5 0 /2ND 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 NORS 0 /NO RESIDUE INDICATOR REAL02 400 REAL03 777 REAL04 777000 REAL05 377400 CN01 400000 CN02 377777 CN03 1 .HX=CE01 CE05=.FS CEHS=.HS 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 LACQ DAC .A5 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 JMS ADN /+ .AA EXT JMS FINI 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 / FINI XX CLL LAC .CE DAC CE05 LAC CE01 JMS ADN JMS .NORD XCT* FINI / / ADD ROUTINE -.CC .CC XX DZM .A4 LAC CE01 /HX CMA!STL TAD .AA /FX SNL JMP CC01 /FX > HX CMA DAC T1 /EX DIF SZA DZM .MF /HAC>FAC JMS .XSE /EXCH SIGN&EX CC04 LAC T1 SNA!CLL JMP CC11 /EX DIF=0 TAD M22 SZL!STL JMP CC03 /DIF > 21 TAD (LRS+10022 /FORM SHIFT JMS CC06 CC11 LAC .CE RAR /SIGN TO L SZL!CLL /SIGNS=? JMS .CM /COMP. FAC CC00 .DSA .AA+200000 /USED BY .CM CLL 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 JMS ADN JMP* .CC /EXIT ADD CC01 TAD CN03 /FX > HX DAC T1 JMS .XFR /EXCH. FRACS JMP CC04 CC03 DAC T1 /DIF=DIF-22 TAD M22 SNL!CLL JMP CC05 /EX DIF > 43 LAC (LRS+10022 JMS CC06 JMP CC04 CC05 JMS .XFR /HAC IS ANS ISZ NORS JMP CC15 / CC06 CAL 0 /SHIFT < 22 DAC CC07 LAC CA4 /(.A4) DAC T2 CC06L CLL LAC* T2 CC07 XX /CLEARS MQ BEFORE SHIFT DAC* T2 LACQ ISZ T2 XOR* T2 DAC* T2 M2 LAW -2 TAD T2 DAC T2 SAD CC00 /= .AA? JMP* CC06 JMP CC06L / .CM CAL 0 /COMP. FAC LAC CA5 / (.A5+1) CM01 TAD M1 /COMP LINK DAC T1 SAD* .CM JMP* .CM LAC* T1 SZL!CMA!STL TAD CN03 DAC* T1 LAC T1 JMP CM01 / CC13 ISZ CE05 /CHANGE SIGN JMS .CM /COMP. FAC .DSA .AA+200000 CC15 CLA!CLL JMP CC14 /NEXT 2 WORDS NEEDED IN / MULTI-BANK COMPUTERS CA4 .DSA .A4+200000 CA5 .DSA .A5+1+200000 /.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 CCB LAC CE01 DAC .AA LAC T2 DAC CE01 JMP* .XSE / / /.CD-NORMALIZE .CD CAL 0 LAW -4 DAC T2 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 LAC .A5 LMQ CLA!CLL XCT CD07 XOR .A4 DAC .A4 LACQ DAC .A5 CD06 JMP* .CD /EXIT CD01 RCR /ARITH OV DAC .AB /SHIFT R1 LAC .AC RAR DAC .AC LAC .A4 RAR DAC .A4 LAC .A5 RAR DAC .A5 DZM .MF ISZ .AA /ADD 1 TO EX JMP* .CD ISZ .AAG M1 LAW -1 /NULL COMMAND JMP* .CD CD02 ISZ T2 SKP JMP* .CD M22 LAW -22 JMS ADN LAC .AC /MOVE UP FAC DAC .AB LAC .A4 DAC .AC LAC .A5 DAC .A4 DZM .A5 JMP CD04 / /.CH-ROUND .RB 0 /0= ROUND />0 NO ROUND .CH XX LAC NORS SZA!CLL /IS RESIDUE IN HAC? JMP CH04 /YES LAW -43 /.AA-35 TAD .AA DAC CE01 GLK TAD .AAG DAC CE02 /SAVE .AAG FOR UN TEST LAC CE05 /INITIALIZE DAC CEHS /RESIDUE SIGN LAC .RB SZA JMP CH02 /NO ROUND LAC .A4 SMA!RAL JMP CH02 /RD BIT=0 GLK TAD .AC DAC .AC GLK TAD .AB DAC .AB SMA!CLL JMP CH01 DZM .MF RAR /ARITH OV DAC .AB ISZ .AA JMP .+3 ISZ .AAG M35 LAW -35 /NULL COMMAND CH01 JMS .CM /COMP. RESIDUE .DSA .AC+200000 /USED IN .CM ISZ CEHS /COMP. SIGN CH02 LAC CE02 /CHECK FOR UN SPA JMP CH03 /UN LAC .A4 /R-SHIFT 1 RCR DAC CE02 LAC .A5 RAR DAC CE03 SAD CE02 /ZERO TEST SZA SKP CH03 JMS RS0 /0 TO HAC CH04 DZM .RB JMP* .CH / .NORD XX JMS .CD /NORMALIZE JMS .CH /ROUND JMS .ZRSN /PACK SIGN SNL!CLC /SKIP IF = 0 LAC .AAG /OV-UN TEST SAD M1 JMP OUT /OK IF -1 SMA JMP .OV /OV IF + .UN LAW 2 /UN IF < -1 JMS ERP CLA JMS .AW /FLOAT 0 OUT LAC .AB JMP* .NORD .OV LAW 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 /SAVE OP NAME DZM .AAG DZM NORS 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 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 ISZ CEHS /- RESIDUE 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 JMS RS0 /0 TO HAC JMP* .AW AW02 400021 / /.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 /INTEGER OV JMS ERP /OTS 0 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 / /ROUTINES USED IN MULTI-PREC. PACKAGE / .XCH XX /EXCHANGE HAC&FAC JMS .XFR JMS .XSE JMP* .XCH / RS0 XX /0 TO HAC DZM CE01 DZM CE02 DZM CE03 JMP* RS0 / / .APH XX /STORE HAC LAC* .-1 DAC .+3 JMS .XCH /SWITCH FAC&HAC JMS .AP /STORE HAC 0 JMS .XCH ISZ .APH JMP* .APH / / 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 ADDRESS DAC ERA TAD M2 JMS* .SP /PRINT ERROR MES ERA 0 ERN 0 0 LAW 40 LAW 40 LAW 100 LAW 40 JMS* .ER ERC 400000 JMP* ERP .RE=ERP / .END