/STANDARD FUNCTIONS FOR ROGALGOL FIELD 1 *5040 FIX, 0; CLA; TAD EXP; SMA CLA; CMA; DCA SIGN CLA CLL CMA RAR; AND EXP; TAD FIX1 SPA SNA; JMP TOSMAL TAD FIX2; SMA; JMS I FIX3 CMA; DCA FIXSH; TAD HORD; LSR FIXSH, 0; ISZ SIGN; CIA; DCA EXP; JMP I FIX TOSMAL, CLA; DCA EXP; JMP I FIX FIX1, -2000 FIX2, -14 FIX3, 1200 SIN2, 6000; 5125; 5422 SIN3, 1775; 5054; 5154 SIN4, 5771; 4357; 1430 FEX1, 2001; 5612; 5070 EX2, 1777; 5427; 1032 EX3, 2006; 7405; 6130 EX4, 6012; 4547; 1570 EX5, 2004; 6003; 6602 AT1, 1776; 5455; 4336 AT2, 2002; 7326; 2162 AT3, 2003; 6606; 1560 AT4, 6003; 7066; 5222 AT5, 2002; 6503; 7330 AT6, 5777; 4170; 7700 AT7, 2001; 5626; 6300 LN1, 2000; 5520; 2360 LN2, 2002; 5612; 5100 LN3, 2000; 7542; 1354 LN4, 2000; 4625; 3252 LN5, 2000; 4000; 0000 LN6, 2000; 5427; 1032 *5200 SINE, 0; JMS ABSFL; JMS FMUL; TWODPI JMS SPLIT; TAD RSIGN; AND (3 TAD (JMP I SINFAN; DCA .+1; HLT SINFAN, Q1; Q2; Q3; Q4 Q2, JMS FINVS; FONE; JMP Q1 Q3, JMS FNEG; JMP Q1 Q4, JMS FSUB; FONE Q1, JMS FPUT; NEGMKR; JMS SQUARE; JMS FPUT; TEM JMS FMUL; SIN4; JMS FADD; SIN3 JMS FMUL; TEM; JMS FADD; SIN2 JMS FMUL; TEM; JMS FADD; SIN1 JMS FMUL; NEGMKR; JMS RSIGN JMP I SINE COS, 0; JMS FADD; PIDTWO; JMS SINE; JMP I COS FLEXP, 0 JMS FMUL; FEX1; JMS SPLIT JMS FMUL; EX2; JMS FPUT; NEGMKR JMS SQUARE; JMS FADD; EX3; JMS FINVD; EX4 JMS FADD; EX5; JMS FSUB; NEGMKR; JMS FPUT; TEM JMS FGET; NEGMKR; ISZ EXP; NOP JMS FDIV; TEM; JMS FADD; FONE JMS SQUARE; TAD RSIGN; TAD EXP; DCA EXP JMP I FLEXP SPLIT, 0; JMS FPUT; EX1 /SAVE FLAC JMS FIX; TAD EXP; DCA RSIGN /SAVE INTEGER PART JMS FLOAT; JMS FNEG /-WHOLE NUMBER PART JMS ADD; JMP I SPLIT ABSFL, 0; CLA CLL CML RAR; AND EXP; DCA FLEXP /SAVE SIGN CLA CLL CMA RAR; AND EXP; DCA EXP /ABS VALUE JMP I ABSFL RSIGN, 0; TAD EXP; TAD FLEXP; DCA EXP; JMP I RSIGN FONE, 2001; 4000; 0 TWODPI, 2000; 5057; 4604 SIN1, 2001; 6220; 7716 *5400 ARCTAN, 0; JMS ABSFL; JMS FPUT; NEGMKR JMS FSUB; FONE TAD EXP; SPA CLA; JMP ATN1 JMS FGET; FONE; JMS FDIV; NEGMKR JMS FPUT; NEGMKR; CLA CMA ATN1, DCA LN JMS FGET; NEGMKR; JMS SQUARE; JMS FPUT; TEM JMS FADD; AT7; JMS FINVD; AT6; JMS FADD; AT5 JMS FADD; TEM; JMS FINVD; AT4 JMS FADD; AT3; JMS FADD; TEM JMS FINVD; AT2; JMS FADD; AT1 JMS FMUL; NEGMKR; ISZ LN; JMP ATPOS JMS FINVS; PIDTWO ATPOS, JMS RSIGN; JMP I ARCTAN LN, 0; TAD EXP; SPA SNA; JMS 1200 /ERROR IF <=0 CLA CLL CMA RTR; TAD EXP; SZA CLA; JMP DOLN /EXP NOT 1 CLA CLL CML RAR; TAD HORD; SNA; TAD LORD SZA CLA; JMP DOLN /ARGUMENT NOT ONE DCA EXP; DCA HORD; DCA LORD; JMP I LN DOLN, TAD EXP; TAD (-2000; DCA ARCTAN TAD (2000; DCA EXP JMS FPUT; NEGMKR; JMS FADD; LN1 JMS FPUT; TEM; JMS FGET; NEGMKR; JMS FSUB; LN1 JMS FDIV; TEM; JMS FPUT; NEGMKR; JMS SQUARE JMS FPUT; TEM; JMS FMUL; LN4; JMS FADD; LN3 JMS FMUL; TEM; JMS FADD; LN2; JMS FMUL; NEGMKR JMS FSUB; LN5; JMS FPUT; TEM TAD ARCTAN; DCA EXP; JMS FLOAT JMS FADD; TEM; JMS FMUL; LN6 JMP I LN PIDTWO, 2001; 6220; 7734 /NEW FLOATING POINT ROUTINES. WRITTEN TO USE EAE, FOR NON-EAE /MACHINES ADD INTEGER MULTIPLY AND DIVIDE AND SHIFT RIGHT LOGICAL. *40 EX1, 0 AC1H, 0 AC1L, 0 SIGN, 0 EXP, 0 HORD, 0 LORD, 0 X, 0 DSWIT=60; CHAR=57; SUDOMQ=33 *5600 FGET, 0; SNA; TAD I FGET; ISZ FGET; TAD M1; DCA 11 TAD I 11; DCA EXP TAD I 11; DCA HORD TAD I 11; DCA LORD; JMP I FGET GETOP, 0; TAD M1; DCA 11 TAD I 11; DCA EX1 TAD I 11; DCA AC1H TAD I 11; DCA AC1L; JMP I GETOP FADD, 0; SNA; TAD I FADD; ISZ FADD JMS GETOP; JMS ADD; JMP I FADD FMUL, 0; SNA; TAD I FMUL; ISZ FMUL; JMS GETOP JMS FMULT; JMP I FMUL XORSGN, 0 /SET SIGN FOR MULTIPLY AND DIVIDE CLA CLL CML RAR; AND EXP; TAD EX1 RAL; CLA RAR; DCA SIGN CLA CLL CMA RAR; AND EXP; DCA EXP CLA CLL CMA RAR; AND EX1; DCA EX1; JMP I XORSGN FPUT, 0; SNA; TAD I FPUT; ISZ FPUT TAD M1; DCA 11 TAD EXP; DCA I 11; TAD HORD; DCA I 11 TAD LORD; DCA I 11; JMP I FPUT FDIV, 0; SNA; TAD I FDIV; ISZ FDIV; JMS GETOP JMS DIV; JMP I FDIV FINVD, 0; SNA; TAD I FINVD; DCA DIVOP; ISZ FINVD JMS FPUT; EX1 /FLAC TO OPERAND JMS FGET DIVOP, 0 /OPERAND TO FLAC JMS DIV; JMP I FINVD FINVS, 0; SNA; TAD I FINVS; ISZ FINVS; JMS GETOP CLA CLL CML RAR; TAD EXP; DCA EXP /NEGATE FLAC JMS ADD; JMP I FINVS FSUB, 0; SNA; TAD I FSUB; ISZ FSUB; JMS GETOP CLA CLL CML RAR; TAD EX1; DCA EX1 /NEGATE OPERAND JMS ADD; JMP I FSUB SQUARE, 0; JMS FMUL; EXP; JMP I SQUARE FLOAT, 0; CLA CLL CML RAR; AND EXP; DCA SIGN TAD EXP; SPA; CIA; DCA HORD; DCA LORD TAD FLO2; TAD SIGN; DCA EXP JMS NORM; JMP I FLOAT FLO2, 2014 M1, -1 *6000 ADD, 0 CLA CLL CML RAR; AND EXP; TAD EX1 SPA CLA; JMP SUB /SUBTRACT IF SIGNS DIFFER RAR; DCA SIGN /ELSE RESULT SAME SIGN JMS ALIGN; JMP I ADD TAD LORD; TAD AC1L; DCA LORD RAL; TAD HORD; TAD AC1H SZL; JMP ADDOV /MUST SHIFT IF OVERFLOWED DCA HORD; JMP I ADD /IF NOT MUST BE NORMALISED ADDOV, RAR; DCA HORD; TAD LORD; RAR; DCA LORD ISZ EXP; JMP I ADD; JMS 1200 SUB, CLA CLL CML RAR; AND EXP; DCA SIGN JMS ALIGN; JMP I ADD TAD AC1L; CIA; TAD LORD; DCA LORD TAD AC1H; CMA; SZL; CLL IAC TAD HORD; DCA HORD SZL; JMP SUBOK /DID WE SUBTRACT SMALLER? TAD LORD; CIA; DCA LORD /NO SO NEGATE RESULT TAD HORD; CMA; SZL; IAC; DCA HORD CLA CLL CML RAR; TAD EXP; DCA EXP SUBOK, JMS NORM; JMP I ADD NORM, 0 CLA CLL; TAD HORD; SPA CLA; JMP I NORM TAD HORD; SNA; TAD LORD; SNA CLA; JMP NZERO TAD LORD; MQL; TAD HORD; NMI; DCA HORD /AC MUST BE 01XXX SCA; CMA; TAD EXP; DCA EXP /SHIFT 1+NMI SHIFT TAD HORD; SHL; 0 DCA HORD; MQA; DCA LORD; JMP I NORM NZERO, DCA EXP; JMP I NORM *6200 DIV, 0; TAD HORD; SNA CLA; JMP I DIV /DIVIDEND ZERO TAD AC1H; SNA CLA; JMS 1200 /ERROR DIVISOR ZERO JMS XORSGN /SET SIGN AND REMOVE SIGN BITS TAD EX1; CIA; TAD EXP; TAD (2001 /SUBTRACT SPA; JMS 1200; TAD SIGN; DCA EXP /FAIL OVER/UNDERFLOW DCA X; TAD AC1L; DCA DV3; TAD AC1H; DCA DV4 TAD DV4; DCA DV2 TAD LORD; MQL; TAD HORD; LSR; 0; DVI DV2, 0; DCA DV2; MQA; DCA HORD; MUY DV3, 0; CLL CIA; TAD DV2; SNA; JMP DV5 SNL; JMP DV6; DCA DV3 CMA; DCA X; MQA; CLL CIA; MQL SNL; CMA; TAD DV3; DVI DV4, 0; CLA; MQA; CLL CML; ISZ X; CLL CIA DV5, DCA LORD; SNL; CMA; TAD HORD; SMA; JMP DV7 DCA HORD; JMP I DIV DV6, CIA; DCA DV2; TAD DV4; CLL CIA; TAD DV2 SNL; JMP .+5; DCA DV2; CMA; TAD HORD; DCA HORD CLA; TAD DV2; SZA; JMP DV4-1; JMP DV5-1 DV7, DCA HORD; TAD LORD; CLL RAL; DCA LORD TAD HORD; RAL; DCA HORD /SHIFT RESULT LEFT IF NOT NORMALISED CMA; TAD EXP; DCA EXP; JMP I DIV *6336 PSDMUY, 0; DCA MUYAC; TAD (-15; DCA MUYC TAD I PSDMUY; DCA MUYOP; ISZ PSDMUY CLL; JMP MUYST MUYL, SNL; JMP .+3 CLL; TAD MUYOP; RAR; DCA MUYAC MUYST, TAD SUDOMQ; RAR; DCA SUDOMQ TAD MUYAC; ISZ MUYC; JMP MUYL; CLL; JMP I PSDMUY MUYOP, 0 MUYAC, 0 MUYC, 0 *6400 ALIGN, 0 TAD AC1H; SNA CLA; JMP I ALIGN /ZERO OPERAND TAD HORD; SZA CLA; JMP NOTZ /ZERO FLAC RESOP, CLA; TAD EX1; DCA EXP TAD AC1H; DCA HORD TAD AC1L; DCA LORD; JMP I ALIGN /ADDITION DONE NOTZ, CLA CLL CMA RAR; AND EXP; DCA EXP CLA CLL CMA RAR; AND EX1; CIA TAD EXP; SNA; JMP DONE SMA; JMP SHOP /JMP IF FLAC LARGER TAD (27; SPA; JMP RESOP /TOO MUCH SHIFT OF FLAC TAD (-27; CMA; DCA SHFT CLA CLL CMA RAR; AND EX1; DCA EXP /TRANSFER EXPONENT TAD LORD; MQL; TAD HORD; LSR SHFT, 0; DCA HORD; MQA; DCA LORD DONE, ISZ ALIGN RESAC, CLA CLL; TAD EXP; TAD SIGN; DCA EXP; JMP I ALIGN SHOP, TAD (-27; SMA SZA; JMP RESAC /TOO MUCH OPERAND SHIFT TAD (26; DCA SHFT1 TAD AC1L; MQL; TAD AC1H; LSR SHFT1, 0; DCA AC1H; MQA; DCA AC1L; JMP DONE ROOTGO, JMS FPUT; ITER1 DOSQR, JMS FGET; 52; JMS FDIV; ITER1 JMS FADD; ITER1 CLA CMA; TAD EXP; DCA EXP /DIVIDE BY 2 TAD HORD; CIA; TAD ITER1+1; SZA CLA; JMP ROOTGO TAD LORD; CIA; TAD ITER1+2 SMA; CIA; IAC; SPA CLA; JMP ROOTGO; JMP SQROOT+3 ITER1, 0;0;0 SQCON1, 6032 *6600 SQROOT, 0 TAD HORD; SNA CLA; JMP I SQROOT TAD EXP; SPA CLA; JMS 1200 JMS FPUT; 52 TAD EXP; CLL RAR; SZL; IAC; TAD (1000 DCA ITER1; TAD SQCON1; DCA ITER1+1 DCA ITER1+2; JMP DOSQR FMULT, 0; TAD HORD; SZA CLA; TAD AC1H; SZA CLA; JMP DOMUL DCA EXP; DCA HORD; DCA LORD; JMP I FMULT DOMUL, JMS XORSGN /EXTRACT SIGN BITS TAD EXP; TAD EX1; TAD (-2000; SPA; JMS 1200 /OVERFLOW TAD SIGN; DCA EXP /ADD EXPONENTS TAD LORD; DCA MP1; TAD AC1H; MQL MUY MP1, 0; DCA MP1 /2ND POSITION TAD AC1L; DCA M2; TAD HORD; MQL MQA MUY M2, 0; TAD MP1 /ADD PREVIOUS 2ND POSITION BITS MQL; RAL; DCA M2 /PUT THEM IN MQ, SAVE CARRY TAD HORD; DCA M3; TAD AC1H; MQL MQA MUY M3, 0; TAD M2 /ADD CARRY FROM 2ND POSITION DCA HORD; MQA; DCA LORD TAD HORD; SPA CLA; JMP I FMULT CLA CLL; TAD LORD; RAL; DCA LORD TAD HORD; RAL; DCA HORD CMA; TAD EXP; DCA EXP; JMP I FMULT /MINIMUM POSSIBLE PRODUCT IS 0.25 *6714 PSDDVI, 0 DCA DVIAC; TAD I PSDDVI; ISZ PSDDVI DCA PLUSOP; TAD PLUSOP; CLL CIA; DCA DVIOP TAD (-15; DCA DVIC; JMP DIVST DIVL, TAD DVIAC; RAL; TAD DVIOP SNL; JMP NO YES, DCA DVIAC DIVST, TAD SUDOMQ; RAL; DCA SUDOMQ ISZ DVIC; JMP DIVL; TAD DVIAC; CLL; JMP I PSDDVI NO, TAD PLUSOP; CML; JMP YES PLUSOP, 0 DVIAC, 0 DVIC, 0 DVIOP, 0 *7000 FINPUT, 0 CLA CMA; DCA PERSW; CMA; DCA NEGMKR DCA DSWIT; DCA EXP; DCA HORD; DCA LORD DPART, DCA FRACD /ZERO DIGITS AFTER POINT NDIG, JMS DIGIN; JMP NOTDIG; ISZ DSWIT; ISZ FRACD JMS FMUL; TEN; JMS FPUT; TEM; JMS FGET; DIG-1 JMS NORM; JMS FADD; TEM; JMP NDIG /RESULT*10+DIGIT NOTDIG, ISZ PERSW; JMP CONT1 /SECOND PERIOD? ISZ DIG; ISZ DIG; CLA SKP; JMP DPART /NO, IF PERIOD READ ON DCA FRACD /IF NOT ANY PERIOD NO FRACTIONAL DIGITS CONT1, ISZ NEGMKR; JMS FNEG CLA CMA; DCA NEGMKR /SET UP FOR EXPONENT TAD CHAR; TAD (-"E; SNA CLA NEXD, JMS DIGIN; JMP ENDEXP TAD X; CLL RTL; TAD X; CLL RAL; TAD DIG; JMP NEXD /ACCUMULATE EXPONENT ENDEXP, TAD X; ISZ NEGMKR; CIA; CIA; TAD FRACD /-(DECIMAL EXPONENT) CLL CIA; SPA; CLL CML CIA; CMA; DCA FRACD /-(DEC EXP. + 1) RAL; TAD JMSI; DCA FLINS /MAKE JMS FMUL OR JMS FDIV MORE, ISZ FRACD; JMP FLINS; JMP I FINPUT FLINS, 0; TEN; JMP MORE /*10 OR /10 JMSI, JMS I .+1; FMUL; FDIV 2014 DIG, 0; 0 TEN, 2004; 5000; 0 NEGMKR, 0 PERSW, 0 FRACD, 0 TEM, 0; 0; 0 DIGIN, 0 DCA X; JMS IN; TAD CHAR; TAD (-"+; SNA; JMP NOTPL TAD ("+-"-; SZA CLA; JMP NOTPL+1; DCA NEGMKR NOTPL, JMS IN; TAD CHAR; TAD (-272; CLL TAD (12; DCA DIG; SZL; ISZ DIGIN; JMP I DIGIN /EXIT2 IF DIGIT IN, 0; JMS I 77; DCA CHAR; TAD CHAR; SNA; JMP IN+1 TAD (-377; SNA CLA; JMP FINPUT+1; JMP I IN /FLOATING POINT O/P FOR HYBRID EAE FPP *7200 FOUTP, 0 CLA CLL CMA RAL; DCA NEGM; DCA DEXP TAD 56; SZA CLA; JMP NOTEX1 /EXPONENTIAL FORMAT? TAD 60; SNA; TAD (6; DCA 60 TAD 60; TAD (10; DCA 57 /SET A&B FOR EXPONENTIAL FORMAT NOTEX1, TAD (-7; DCA MAXPL; TAD HORD; SNA CLA; JMP OZERO TAD EXP; SMA CLA; JMP OPOS; JMS FNEG; DCA NEGM /NEGATE IF NEEDED OPOS, TAD EXP; TAD (-2000; SMA SZA CLA; JMP EXPPOS JMS FMUL; TEN; ISZ DEXP; JMP OPOS /MAKE EXP>0 EXPPOS, JMS EXPMIN; JMS FPUT; TEM CLA CLL CML RTR; DCA EXP CML RAR; DCA HORD; DCA LORD /FLAC=0.5 TAD 56; SZA CLA; TAD DEXP; CIA TAD 60; SMA; CMA; TAD (7; SPA; CLA; TAD (-7 DCA EXPMIN; JMP .+3 JMS FDIV; TEN; ISZ EXPMIN; JMP .-3 JMS FADD; TEM; JMS EXPMIN /ADD ROUNDING L1, TAD (-2000; TAD EXP; SNA CLA; JMP OZERO ISZ EXP; TAD HORD; CLL RAR; DCA HORD TAD LORD; RAR; DCA LORD; JMP L1 /MAKE MANT FRACTION OZERO, TAD DEXP; DCA X; TAD 56; SZA CLA; JMP NOTEX2 DCA DEXP; TAD (-7; JMP EXPO1 NOTEX2, TAD DEXP; SMA; CLA CMA; TAD (-1 EXPO1, TAD 57; CIA; DCA FDIV TAD 60; SNA; CMA; TAD FDIV; SMA; CLA CMA /WAS ERROR DCA EXPMIN; JMP .+3 TAD (-20; JMS DIGOUT; ISZ EXPMIN; JMP .-3 /LEADING SPACES CLA CLL CMA RTL; TAD NEGM; JMS DIGOUT /SIGN TAD DEXP; SMA; JMP NDBP; CIA; JMS DECOUT; JMP DAP NEGM=52 DEXP=53 MAXPL=54 *7400 DAP, TAD 60; SNA CLA; JMP NDAP; CLA CLL CMA RAL JMS DIGOUT; JMP NDAP /DECIMAL POINT NDBP, CLA; JMS DIGOUT; JMP DAP /ZERO BEFORE POINT NDAP, TAD DEXP; SPA SNA CLA; JMP NZAP /ANY ZEROS AFTER POINT? TAD DEXP; CMA; DCA DECOUT TAD 60; CMA; DCA TEM+2; SKP ZEROL, JMS DIGOUT; ISZ DECOUT; SKP; JMP ZAP /DO ZEROS AFTER POINT ISZ TEM+2; JMP ZEROL ZAP, TAD DEXP; CIA NZAP, TAD 60; SMA SZA; JMS DECOUT /DIGITS AFTER POINT CLA; TAD 56; SZA CLA; JMP EXFOUT JMS CHOUT; "E; TAD X SMA SZA CLA; CLL CML RTL; JMS CHOUT; "+ /+ OR - TAD X; SPA; CIA; MQL DVI; 144; DCA X MQA; JMS DIGOUT; TAD X; MQL DVI; 12 DCA X; MQA; JMS DIGOUT; TAD X; JMS DIGOUT EXFOUT, TAD FOUTP; DCA DIGOUT; JMP I DIGOUT DIGOUT, 0; JMS CHOUT; 260; JMP I DIGOUT CHOUT, 0; TAD I CHOUT; JMS I 71; CLA CLL; JMP I CHOUT DECOUT, 0; CIA; DCA DIGC /COUNT DIGITS MUL10, TAD HORD; MQL MUY; 12; DCA TEM; MQA; DCA HORD TAD LORD; MQL MUY; 12; CLL; TAD HORD; DCA HORD MQA; DCA LORD; RAL; TAD TEM ISZ MAXPL; JMP EXDOUT; CLA CMA; DCA MAXPL EXDOUT, JMSDIGOUT; ISZ DIGC; JMP MUL10; JMP I DECOUT DIGC, 0 EXPMIN, 0 /MAKE EXP <=0, ADJUSTING DEXP TAD EXP; TAD (-2000; SPA SNA CLA; JMP I EXPMIN JMS FDIV; TEN; CMA; TAD DEXP; DCA DEXP; JMP EXPMIN+1 *7560 FNEG, 0; CLA; TAD EXP; SZA; TAD (4000; DCA EXP; JMP I FNEG $