File: FLT.PA of Tape: Sources/Focal/s6
(Source file text)
IFNZRO FLTLST <XLIST> IFZERO FFNASS < EJECT OS-8 FLOATING POINT ETC. /&1 /WE WILL KEEP THIS PAGE FOR LATER ADDITIONS /&2 /AND THIS ONE /&3 /AND FINALLY THIS PAGE /&4 /EXPONENTIAL GETSGN=TAD HORD FIELD 1 *4620 FEXP, GETSGN /TAKE ABSOLUTE VALUE SPA CLA JMS I NEGP DCA T3 /C(SIGN)=-1 IF I X2.L.0 FINT FMUL LG2E FPUT I X2 FEXT JMS I INTEGER DCA FLAG2 /SAVE LOX ORDER DATA FINT FNOR FPUT I XSQ2 FGET I X2 FSUB I XSQ2 FPUT I X2 FMUL I X2 FPUT I XSQ2 FADD DF FPUT TEMP FGET CF FDIV TEMP FSUB I X2 FADD AF FPUT TEMP FGET BF FMUL I XSQ2 FADD TEMP FPUT TEMP FGET I X2 FDIV TEMP FMUL TWO FADD ONE FEXT TAD FLAG2 TAD EXP DCA EXP ISZ T3 POPJ FINT FPUT I X2 FGET ONE FDIV I X2 FEXT POPJ /&5 /CONSTANTS FOR FEXP X2, X XSQ2, XSQR AF, 0004 2372 1402 BF, 7774 2157 5157 CF, 0012 5454 0343 DF, 0007 2566 5341 LG2E, 0001 2705 2435 ONE, 0001 2000 0000 TWO, 0002 2000 0000 NEGP, FNEG FLAG2, 0 TEMP, 0 0 0 0 /&6 /MAIN ALGORITHM FOR ARCTANGENT ARCALG, FINT FGET I X2 FMUL I X2 FPUT I XSQ2 FMUL BET2 FADD BET1 FMUL I XSQ2 FADD BETZ FPUT TEMP FGET ALF2 FMUL I XSQ2 FADD ALF1 FMUL I XSQ2 FADD ALFZ FMUL I X2 FDIV TEMP FEXT JMP I .+1 ARCRTN /CONSTANTS - FLOATING ARC TANGENT ALFZ, 0000 2437 1643 ALF1, 7777 3304 4434 ALF2, 7773 3306 5454 BETZ, 0000 2437 1646 BET1, 0000 2427 2323 BET2, 7775 3427 7052 /&7 /FLOATING POINT ARC TANGENT *5000 ARTN, GETSGN /TAKE ABSOLUTE VALUE SPA CLA JMS FNEG DCA T3 FINT FPUT X FSUB I CON1 FEXT GETSGN SPA CLA JMP GO /LESS THAN ONE FINT FGET I CON1 FDIV X FPUT X FEXT CLA CMA GO, DCA FLAG1 /SIGN FLAG OF RESULT JMP I .+1 ARCALG ARCRTN, ISZ FLAG1 /RETURN HERE JMP I EXIT1 FINT FPUT X FGET I PI2 FSUB X FEXT JMP I .+1 EXIT1, EXIT2 /CONSTANTS FOR ARCTANGENT PI2, PIOT CON1, ONE /&8 /FLOATING LOGARITHM FLOG, GETSGN SPA SNA ERROR3 /0 OR - ARGUMENT FOR LOG FINT FPUT I TEM FSUB I CON1 FEXT GETSGN SNA POPJ SMA CLA JMP STARTL FINT FGET I CON1 FDIV I TEM FPUT I TEM FEXT CLA CMA STARTL, DCA T3 TAD P13 DCA EXP CMA TAD I TEM DCA HORD DCA LORD DCA OVER2 IAC DCA I TEM FINT FMUL LOG2 FPUT X FGET I TEM FSUB I CON1 FPUT I TEM FMUL LOG8 FADD LOG7 FMUL I TEM FADD LOG6 FMUL I TEM FADD LOG5 FMUL I TEM FADD L4 FMUL I TEM FADD L3 FMUL I TEM FADD L2 FMUL I TEM FADD L1 FMUL I TEM FADD X FEXT JMP I EXIT1 /&9 L1, 0000 3777 7742 L2, 7777 4000 4100 L3, 7777 2517 0307 L4, 7776 4113 7211 /LOGARITHM CONSTANTS LOG5, 7776 2535 3301 LOG6, 7775 4746 0771 LOG7, 7774 2236 4304 LOG8, 7771 4544 1735 TEM, TEMP LOG2, 0 2613 4414 FLAG1, 0 FNEG, 0 JMS I MINSKI CLA CMA JMP I FNEG X, 0 0 0 0 XSQR, 0 0 0 0 /&10 /FLOATING POINT SINE AND COSINE *5200 FCOS, FINT /COS(X)=SIN(PI/2-X) FPUT I X1 FGET PIOT FSUB I X1 FEXT FSIN, GETSGN SMA SZA CLA JMP MOD GETSGN SMA CLA POPJ /YES SIN(0)=0 JMS I MINSKI CMA /NO:SIN(-X)=-SIN(X) MOD, DCA T3 FINT FDIV TWOPI /REDUCE X MODULO 2 PI FPUT I XSQR1 FEXT JMS I INTEGER FINT FNOR FPUT I X1 FGET I XSQR1 FSUB I X1 FMUL TWOPI FPUT I X1 FSUB PI /X .L. PI? FEXT GETSGN SPA CLA JMP PCHECK /YES FINT /NO, SIN(X-PI)=-SIN(X) FPUT I X1 FEXT TAD T3 CMA DCA T3 /&11 PCHECK, FINT /X.L.PI/2? FGET I X1 FSUB PIOT FEXT GETSGN SPA CLA JMP PALG /YES FINT /NO FGET PI /SIN(X)=SIN(PI-X) FSUB I X1 FPUT I X1 FEXT PALG, FINT FGET I X1 FDIV PIOT FPUT I X1 FMUL I X1 FPUT I XSQR1 FGET C9 FMUL I XSQR1 FADD C7 FMUL I XSQR1 FADD C5 FMUL I XSQR1 FADD C3 FMUL I XSQR1 FADD PIOT FMUL I X1 FEXT EXIT2, ISZ T3 POPJ JMS I MINSKI POPJ /&12 /CONSTANTS AND POINTERS TWOPI, 0003 3110 3755 /3756 3-WORD 2421 PI, 0002 3110 3755 /3756 3-W0RD 2421 PIOT, 0001 /USED BY SINE AND COSINE 3110 3755 /3756 3-W0RD 2421 X1, X XSQR1, XSQR /SINE CONSTANTS C9, 7764 2441 7015 1042 C7, 7771 5464 5514 6150 C5, 7775 2431 5361 4736 C3, 0000 5325 0414 3167 /&13 FRAN, FENT /PSEUDO RANDOM NUMBER FGET RNDM /X(1)=(2^17+3)*X(0) MOD.2^16 FPUT ADDR FEXT TAD M16 DCA T1S JMS I DOUBLE ISZ T1S JMP .-2 JMS I ADDO JMS I DOUBLE JMS I ADDO /2*(2^16*X+X)+X FINT FPUT RNDM FEXT DCA EXP CLA CLL CMA RAR /=3777 AND HORD DCA HORD /BE SURE IT'S POSITIVE POPJ M16, -16 ADDO, DUBLAD RNDM=. T1S, 0000 4421 3040 0001 /END OF EXTENDED FUNCTIONS......... /&14 /INPUT-OUTPUT ROUTINES FOR THE /FOCAL FLOATING POINT PACKAGE /IN THE COMMENTS BELOW:- /F=NUMBER OF DIGITS TO BE OUTPUT =FISW ---F--- /D=NUMBER OF DEZIMAL PLACES =DECP ABC.DEF E GHI /E=DEZIMAL EXPONENT =BEXP -D- -E- /P=NUMBER OF PLACES REMAINING TO BE /PRINTED BEFORE DEZIMAL POINT *5400 DIGITS=12 /NUMBER OF DEZIMAL DIGITS OUT TGO, 0 DCA SCOUNT /SAVE MAX. NUMBER OF DIGITS AVAILABLE - SET COUNT TAD FISW AND FPRNT-1 BSW RAR DCA T1 /F TAD T1 CIA /NO, COMPUTE FIELD SIZES SNA TAD MD DCA FCOUNT /-F TAD FISW /(JMP FPRNT) - FOR NO ROUNDING SNA /FLOATING OUTPUT ? JMP R6 /YES, ROUND UP TO MAX. NO. OF PLACES AND P77 DCA DECP /D TAD FCOUNT TAD DECP /D-F SPA /F-D .G. 0 ? JMP .+5 /YES CLA CMA /NO TAD T1 DCA DECP /MAKE D=F-1 CMA TAD T3 /COMPARE DEZ. EXPONENT D-F+E SMA /F-D .G. E ? CLA /NO, ROUND OF TO .F PLACES TAD T1 /YES SPA /D+E.L.0 ? JMP FPRNT-2 /YES, NO ROUNDING NEEDED, GO TO PRINT TAD MD /NO, ROUND TO D+E PLACES SMA /TO A MAX OF D PLACES CLA /&15 R6, TAD RND2 /*ROUND UP* DCA T2 /SAVE NUMBER+1 OF PLACES TO ROUND TO TAD I BUFST TAD T2 /SET UP BUFFER ADDRESS AT WHICH DCA PLCE /ROUNDING OFF SHOULD START TAD T2 CIA /SETUP COUNT OF MAX NO DCA T2 /OF CARRIES ALLOWABLE TAD K5 /LITTLE EXTRA ON FIRST DIGIT RET, ISZ I PLCE /ADD ONE TO DIGIT AT CURRENT POSITION TAD I PLCE TAD OM12 SPA CLA /CARRY REQUIRED ? JMP FPRNT /NO, GO TO OUTPUT DCA I PLCE /YES, MAKE CURRENT DIGIT ZERO ISZ T2 /BEGIN OF BUF REACHED ? JMP DECR /NO, DECREMENT BUF ADDR. AND REPEAT ISZ I PLCE /YES, SET MANTISSA TO .1 ISZ T3 /COMPENSATE BY INCREMENTING EXP 7600 /CLA - REFERENCED FPRNT, TAD FISW /AUTO-INDEX REG ALREADY SET - *PRINT* SNA CLA /F=0 ? JMP FLOUT /YES, OUTPUT AS FLOAT NUMBER TAD FCOUNT TAD T3 SMA SZA /E .G. F ? JMP FLOUT-1 /YES, CONVERT TO E FORMAT TAD DECP /-F-E+D SMA /E.L.F-D ? CLA /NO, P=E CIA /YES, TAKE P=F-D TAD T3 CIA DCA T1 /SETUP -P BACK1, TAD T3 /PRINT DD.DDD TAD T1 SNA CLA /B=E ? JMP DIG /YES, PRINT DIGIT TAD T1 /NO, IAC SPA CLA /P .G. 1 ? TAD M20 /YES, TAKE SPACE (240-260); OTHERWISE IN, JMS OUTA /ZERO PRINT CHARAKTER ISZ T1 /P CHARAKTERS PRINTED ? JMP BACK1 /NO TAD PER /YES PRINTC /PRINT DEZ POINT JMP BACK1 /&16 DECR, CMA /BACKUP TO TOP OF BUF TAD PLCE DCA PLCE JMP RET K5, 5 MD, -DIGITS RND2, DIGITS+1 OM12, -12 BUFST, SADR OPUT, OUTDG DECP, 0 /MODIFYABLE LOCATIONS SCOUNT, 0 FCOUNT, 0 PLCE=. OUTA, 0 /MODIFIED REGISTERS JMS I OPUT /PRINT CHAR ISZ FCOUNT /F CHARS PRINTED ? JMP I OUTA /NO, RETURN JMP I TGO /YES, NUMBER FINISHED DIG, CMA TAD T3 /REDUCE E BY ONE DCA T3 ISZ SCOUNT /ALL SIGNIFICANT FIGURES USED ? JMP .+4 /NO CMA /YES DCA SCOUNT /RESET COUNT TO -1 JMP IN /AND LEAVE C(AC)=0 TAD I FLTXR /TAKE NEXT DIGIT FROM BUF JMP IN /DO FLOATING OUTPUT,PLEASE CLA /IF OUTPUT TOO LARGE FLOUT, JMS I OPUT /PRINT "0" TAD PER PRINTC /PRINT "." ISZ TGO /2ND RETURN TAD I FLTXR /TAKE NEXT DIG FROM BUF JMS OUTA /PRINT IT ISZ SCOUNT /TEST FOR END OF INPUT JMP .-3 /AND REPEAT CMA DCA SCOUNT /OUTPUT EXTRA ZERO'S JMP .-5 RESOLV, 0 TAD SIGNF SPA CLA JMS I MINSKI CLA CLL JMP I RESOLV /&17 /DOUBLE PRECISION DEZIMAL BINARY /INPUT AND CONVERSION FOR + OR - XXX.... *5600 DECONV, 0 DCA LORD DCA EXP /ZERO THE EXP AND DCA HORD /INITIALIZE FLAC DCA OVER2 DCA DNUMBR DCA SIGNF TAD CHAR /ALLOW KEYBOARD SIGN CHECKS TAD MPLUS SNA JMP .+6 /PLUS SIGN; GET NEXT TAD M2 /CHECK MINUS SIGN SZA CLA JMP .+4 CMA /INIT SIGN CHECK TO POS. DCA SIGNF JMS I XINPUT /GET NEXT TAD CHAR /A SPACE PERHAPS ? TAD MSPACE SNA CLA JMP .-4 JMS DECON JMP I DECONV /&18 DECON, 0 TAD CHAR /TEST LEAD. CHAR FOR TERMINATOR TAD MINE SNA CLA JMP I DECON /E TESTN JMP I DECON /. JMP DTST /OTHER TAD SORTCN /N DSAVE, DCA DIGIT /YES JMS MULT10 /REMAIN MUST =0 SINCE OVERFL. IS CHECKED ISZ DNUMBR /COUNT DIGITS SZA CLA ERROR2 /INPUT OVERFL ERROR JMS I XINPUT JMP DECON+1 /CONTINUE DTST, TAD CHAR /ALLOW A-Z TAD MINUSA SPA CLA JMP I DECON TAD CHAR TAD MINUSZ SZA SMA CLA JMP I DECON /USE 6 BITS OF ASCII TAD CHAR AND P77 JMP DSAVE MINE, -305 MINUSZ, -332 MPLUS, -253 MSPACE, -240 XINPUT, INPUT /&19 MULT10, 0 /ROUTINE TO MULTIPLY FLAC BY 10 TAD OVER2 DCA OVER1 TAD LORD /DOUBLE PRECISION WORD DCA AC1L /BY 10(DEZ) TAD HORD /REMAIN=REMAINDER DCA AC1H DCA REMAIN /CLEAR OVERFLOW WORD JMS MULT2 /CALL SR TO JMS MULT2 /MULT BY 2 JMS DUBLAD /CALL DOUBLE ADD JMS MULT2 TAD DIGIT /ADD LAST DIGIT RECEIVED DCA OVER1 DCA AC1L DCA AC1H JMS DUBLAD TAD REMAIN /EXIT WITH REMAINDER JMP I MULT10 /IN AC REMAIN, 0 DIGIT, 0 /STORAGE FOR DIGIT DNUMBR, 0 /= NUMBER OF DIGITS MULT2, 0 /MULTIPLY OVER2, LORD, HORD BY TWO TAD OVER2 CLL RAL /CARRY INSERT BIT IS IN LINK DCA OVER2 TAD LORD RAL DCA LORD TAD HORD RAL DCA HORD TAD REMAIN RAL DCA REMAIN JMP I MULT2 /&20 DUBLAD, 0 /TRIPLE PRECISION ADDITION CLA CLL TAD OVER2 TAD OVER1 DCA OVER2 RAL TAD LORD TAD AC1L DCA LORD RAL TAD HORD TAD AC1H DCA HORD RAL TAD REMAIN DCA REMAIN JMP I DUBLAD DIV1, 0 /SHIFT OPERAND RIGHT CLA CLL /TRIPLE PRECISION TAD AC1H SPA CLL CML RAR DCA AC1H TAD AC1L RAR DCA AC1L TAD OVER1 RAR DCA OVER1 ISZ EX1 JMP I DIV1 JMP I DIV1 XIDLE, 0 /DUMMY JMP I XIDLE /&21 /FLOATING OUTPUT CONVERSION ROUTINE *6000 FLOUTP, 0 TAD PEQ /IT'S A SPACE !! PRINTC /(CLA) - TO SUPPRESS TAD HORD /NUMBER .G. 0 ? SMA CLA TAD SMSP /PRINT "-" OR A SPACE TAD SMIN PRINTC JMS I ABSOL2 FGO2, DCA T3 /INITIALIZE DEZ EXP TAD EXP /IS EXP 0-4 ? SPA JMP FGO3 /TOO SMALL: MULT BY 10 SZA TAD M4 SPA SNA CLA JMP FGO4 FINT FMUL I PPTEN / /10 FEXT IAC TAD T3 JMP FGO2 FGO3, FINT FMUL I TENPT /*10 FEXT CMA JMP .-6 /&22 FGO4, DCA I DPT /MULTIPLY BY TWO TO POSITION BIT0 DCA I REPT /CLEAR OVERFLOW WORD TAD SADR /INIT BUFFER POINTER DCA FLTXR TAD EXP /COMPUTE BITS IN 1ST DIGIT CMA CLL DCA OUTDG /TEMP COUNT TAD DCOUNT /SETUP COUNT OF TOTAL OUTPUT DCA EXP JMS I DOUBLE /ROTATE OUT THE 1ST 4 BITS ISZ OUTDG JMP .-2 TAD I REPT /TEST FOR 10-15,0,1-9 SNA JMP FGO5 /IGNORE 1ST ZERO TAD FM12 SPA CLA JMP .+7 /0-9 IAC DCA I FLTXR /OUTPUT A 1 ISZ EXP /COUNT THE DIGIT TAD FM12 /CORRECT REMAINDER ISZ T3 /BUMP DECIMAL EXP NOP TAD I REPT /COMPUTE RESULTANT OR SECOND DIGIT ISZ T3 NOP SKP FGO5, JMS I M10PT /IE. .672X10=6+.72.. ETC. DCA I FLTXR ISZ EXP /ALL DIGITS OUTPUT?? JMP .-3 /NO:CONTINUE TAD SADR /INIT BUFFER POINTER DCA FLTXR TAD DCOUNT JMS I ROUND /OUTPUT MANTISSA JMP I FLOUTP /FIXED POINT DONE TAD CHRT /PRINT "E" PRINTC /&23 /OUTPUT THE EXPONENT TAD T3 /TAKE ABSOLUTE VALUE OF EXPONENT SPA CIA DCA HORD /SAVE + POWER TAD T3 /PRINT SIGN SMA CLA TAD M2 TAD SMIN PRINTC TAD HORD ISZ EXP TAD M144 SMA JMP .-3 TAD C144 DCA HORD /SAVE TENS AND UNITS CMA /OUTPUT HUNDREDS TAD EXP SZA /UNLESS ZERO JMS OUTDG TAD HORD /PRINT TWO DIGITS JMS I PRNTI JMP I FLOUTP PRNTI, PRNT CHRT, 305 /E SMSP, 240-255 PEQ, 240 /SPACE!!!!!! SMIN, 255 M144, -144 /-100 C144, 0144 /+100 M4, -4 FM12, -12 DCOUNT, -DIGITS-1 /NUMBER OF DIGITS TO OUTPUT -3-WORD-! PPTEN, PTEN /IEI DPT, DIGIT REPT, REMAIN /OVERFLOW FROM INTEGER MULTIPLY M10PT, MULT10 SADR, BUFFER-1 ROUND, TGO /ACTUAL OUTPUT ROUTINE TENPT, TEN ABSOL2, ABSOLV /&24 OUTDG, 0 /OUTPUT ONE DIGIT TAD C260 PRINTC JMP I OUTDG THISD, 0 CDF T TAD I THISLN CDF P JMP I THISD PT1D, 0 CDF T TAD I PT1 CDF P JMP I PT1D ICHARF, 0 /INPUT A CHARACTER FROM A FILE CIF CDF L JMS I .+2 JMP I ICHARF ICHAR /&25 /FLOATING POINT INPUT *6200 FLINTP, 0 /IF C(AC)=0, USE CHAR SZA CLA /IF C(AC)#0, GET NEXT JMS I XIN /GET FIRST CHAR TSTCHR 7540 /-SPACE SKP JMP .-4 JMS I DPCVPT /READ FIRST DIGIT GROUP TSTCHR /ENDED BY PERIOD? -". JMP FIGO1 JMS I XIN /YES, READ SECOND GROUP DCA I DPN JMS I DCONP TAD I DPN /SAVE NUMBER OF DIGITS IN T3 CMA IAC FIGO1, DCA T3 /NO TAD P43 DCA EXP JMS I RESOL5 JMS I INORM /NORMALIZE FIRST ,THEN FINT /SAVE NUMBER FPUT I PT1 FEXT TSTCHR /"E" READ IN? -"E JMP ENDFI+3 /NO JMS I XIN /YES, READ 3RD DIGIT GROUP JMS I DPCVPT /I.E. CONVERT DECIMAL EXPONENT JMS I RESOL5 TAD OVER2 TAD T3 /C(SEXP) PLACES TO RIGHT OF LAST DIGIT DCA T3 /&26 /COMPENSATE FOR DECIMAL EXPONENTS ENDFI, FINT /RESTORE MANTISSA FGET I PT1 FEXT TAD T3 /TEST DECIMAL EXPONENT SNA JMP I FLINTP /FINISHED SMA CLA JMP FIGO4 FINT /. IS TO THE LEFT: FMUL PTEN /TIMES .1000 FPUT I PT1 FEXT IAC JMP .+6 FIGO4, FINT /. IS TO THE RIGHT: FMUL TEN /TIMES TEN FPUT I PT1 FEXT CMA TAD T3 DCA T3 JMP ENDFI+3 TEN, 0004 2400 0000 0000 PTEN, 7775 3146 3146 /3147 3-WORD 3150 DPCVPT, DECONV DCONP, DECON RESOL5, RESOLV DPN, DNUMBR XIN, INPUT INORM, DNORM P43, 43 /&27 XTAB, PUSHJ EVAL-1 FENT FADD I TRND /LET'S ROUND OFF FEXT JMS I INTEGE CIA TAD TABC IAC SMA JMP BACK DCA CNTRX TAD SPACE PRINTC ISZ CNTRX JMP .-3 BACK, CLA CLL JMP I .+1 TASK TRND, FLP5 SPACE, 240 CNTRX, 0 FILER, CIF CDF L JMP I .+1 FILEST /&28 XRTD, 0 CDF T TAD I XRT CDF P JMP I XRTD ABSOLV, 0 TAD HORD DCA SIGNF TAD HORD SPA CLA JMS I MINSKI JMP I ABSOLV MINUS2, 0 /NEGATE OPERAND CLA CLL /TRIPLE PRECISION TAD OVER1 CMA IAC DCA OVER1 TAD AC1L CMA SZL IAC CLL DCA AC1L TAD AC1H CMA SZL IAC CLL DCA AC1H JMP I MINUS2 PAXCHK, 0 CDF T DCA I PAXPNT CDF P JMP I PAXCHK PAGE /&29 /FLOATING POINT INTERPRETER FOR FOCAL FPNT, 0 7600 /CLA;REFERENCED CLL NOP /DCA OVER1 NOP /DCA OVER2 3-WORD TAD I FPNT /GET NEXT INSTRUCTION SNA JMP I FPNT /FAST EXIT DCA JUMP TAD JUMP AND C200 /GET PAGE BIT SNA CLA /PAGE ZERO? JMP .+3 /YES TAD FPNT+1 /NO AND FPNT /C(FPNT) 0-4 CONTAINS PAGE BITS DCA ADDR TAD P177 /GET 7 BIT ADRESS AND JUMP TAD ADDR DCA ADDR TAD INDRCT /INDIRECT BIT =1? AND JUMP SNA CLA JMP LOOP01 /NO- GO ON TAD I ADDR /YES, DEFER W/O AUTO-INDEX DCA ADDR LOOP01, ISZ FPNT CMA TAD ADDR DCA FLTXR2 TAD JUMP /GET COMMAND CLL RTL RTL AND P17 /GET BITS 0-2,I.E. OPCODE SNA JMP FLGT TAD TABLE /LOOK UP THE TABLE DCA JUMP TAD I JUMP SNA JMP FLPT DCA JUMP TAD CEX1 /SAVE FLOATING ARGUMENT,UNLESS 'GET' OR 'PUT' DCA FLTXR TAD MFLT DCA CNTR TAD I FLTXR2 DCA I FLTXR ISZ CNTR JMP .-3 JMP I JUMP /GO THERE /&30 JUMP, 0 ADDR=EX1 INDRCT, 0400 TABLE, ITABLE FLPT, TAD CEXP /EXP TO (ADDR) JMP .+5 FLGT, TAD CEXP /(ADDR) TO EXP DCA FLTXR2 CMA TAD ADDR DCA FLTXR /SAVE 'FROM' ADRESS TAD MFLT /3 OR 4 WORDS DCA CNTR TAD I FLTXR DCA I FLTXR2 ISZ CNTR JMP .-3 JMP FPNT+1 CEXP, EXP-1 CEX1, EX1-1 FLSU, JMS I OPMINS /FSUB = 2, NEGATE THE OPERAND FLAD, JMS I ALGN /FLAD = 1, FIRST ALIGN EXPONENTS JMP FPNT+1 /RETURN IF NO ALIGMENT IS POSSIBLE JMS I RAR2 /TRIPLE PRECISION ADDITION JMS I RAR1 /SINCE BITS ARE SHIFTED JMS I TRAD /RIGHT NORF, JMS I NORM /NORMALIZE THE RESULT JMP FPNT+1 /HINT: USE 700X FOR FUNCTIONS /&31 /INTERPRETIVE POWER FLEX, TAD HORD /ZERO? SZA CLA JMP .+6 ZERO, DCA EXP /YES DCA HORD DCA LORD DCA OVER2 JMP FPNT+1 PUSHF /AC TO A + POWER FLAC PUSHF /SETUP ARGUMENT (THE EXPONENT) EX1 POPF FLAC JMS I INTEGER /ONLY POSITIVE, INTEGER EXPONENTS SPA JMP .+5 /(COULD DIVIDE) CMA DCA JUMP /TEMP STORAGE NOP /DCA OVER1 3-WORD TAD HORD SZA CLA ERROR2 /TOO LARGE OR NEGATIVE EXPONENT PUSHF /INITIALIZE TO ONE FLTONE POPF FLAC POPF ITER1 JMP .+6 PUSHF ITER1 POPF EX1 JMS I MULT /"MULT" ISZ JUMP JMP .-6 JMP FPNT+1 /&32 FLMY, JMS I MULT /MULTIPLY JMP FPNT+1 OPMINS, MINUS2 MULT, DMULT NORM, DNORM ALGN, ALIGN RAR1, DIV1 RAR2, DIV2 TRAD, DUBLAD ITABLE=.-1 FLAD FLSU FLDV FLMY FLEX 0000 NORF ACMINS, 0 /ROUTINE TO COMPLEMENT FLAC - VIA "MINSKI" CLL CLA TAD OVER2 /TRIPLE PRECISION NEGATION CMA IAC /OF FLOATING AC DCA OVER2 TAD LORD CMA SZL IAC CLL DCA LORD TAD HORD CMA SZL IAC CLL DCA HORD JMP I ACMINS /&33 ALIGN, 0 /SUBROUTINE TO ALIGN TAD HORD /BINARY POINTS SNA TAD LORD SNA CLA /IS MANTISSA ZERO? JMP NOX1 /YES, RESULT=OPERAND TAD AC1H /NO, IS OPERAND ZERO? SNA TAD AC1L SNA TAD OVER1 SNA CLA JMP I ALIGN /YES, EXIT TAD EX1 CMA IAC TAD EXP SNA /ARE EXPONENTS EQUAL? JMP ADONE DCA ACMINS TAD ACMINS SMA /NO CIA /NEGATE AND DCA AMOUNT /SAVE THE DIFFERENCE TAD AMOUNT TAD TEST2 SPA CLA /CAN THE EXPONENTS BE ALIGNED? JMP NOX /NO, USE LARGER OF THE TWO TAD ACMINS /YES, SHIFT THE SMALLER SMA CLA JMP ASHFT JMS DIV2 ISZ AMOUNT JMP .-2 JMP ADONE /&34 ASHFT, CMA TAD EX1 DCA EX1 JMS I TAG1 ISZ AMOUNT JMP .-2 ADONE, ISZ ALIGN JMP I ALIGN NOX, TAD EX1 /MISSION IMPOSSIBLE! SMA CLA /CHECK FOR SIGN DIFFERENCE JMP NOX2 TAD EXP SMA CLA JMP I ALIGN /-+ JMP .+3 /-- NOX2, TAD EXP SMA CLA TAD ACMINS /TEMP STORAGE OF DIFFERENCE, SMA SZA CLA /-BOTH POSITIVE EXP OR BOTH NEG JMP I ALIGN /OK (+-) NOX1, TAD EX1 /USE LARGER DCA EXP TAD AC1H DCA HORD TAD AC1L DCA LORD TAD OVER1 DCA OVER2 JMP I ALIGN AMOUNT, 0 TAG1, DIV1 P27, 27 ABSOL, ABSOLV RESOL, RESOLV /&35 /LEAVE 12 BIT ANSWER IN AC UPON RETURN /LEAVE FLAC AS AN INTEGER FIX, 0 /VIA (INTEGER) JMS I ABSOL TAD EXP /TEST FOR FRACTION SPA SNA CLA JMP FIXM /DOUBLE CHECK FOR MINUS ONE IAC DCA OVER1 TAD P27 /INIT ALIGNEMENT DCA EX1 JMS ALIGN /DO THE ALIGNEMENT TO AN INTEGER TEST2, 0043 /ALREADY DONE; (27) FOR 3-WORD ISZ OVER2 JMP .+4 ISZ LORD SKP ISZ HORD DCA OVER2 /CLEAR THE FRACTION JMS I RESOL TAD LORD /EXIT WITH LOW ORDER RESULT IN AC JMP I FIX FIXM, DCA EXP /CLEAR EXPONENT DCA HORD DCA LORD JMP TEST2+6 DIV2, 0 /SHIFT FLAC RIGHT CLA CLL TAD HORD SPA CML RAR DCA HORD TAD LORD RAR DCA LORD TAD OVER2 RAR DCA OVER2 ISZ EXP JMP I DIV2 JMP I DIV2 PAGE /&36 /(A+B+C)*(D+E+F)=C*F,C*E,B*F,C*D,A*F,B*E,A*E,B*D,A*D DMULT, 0 /N-PRECISION MULTIPLY WITH IAC /PRODUCT IN TRIPLE PRECISION TAD EX1 /ADD EXPONENTS + 1 JMS SIGN /AND DETERMINE SIGN OF RESULT SPA CLA JMS I MINI DCA DATUM-1 /INIT RESULT DCA DATUM-2 DCA DATUM-3 DCA DATUM-4 TAD A /A*D SAVE /STORE IN MP2 TAD D /SINGLE PREC MULT MULTY 2 /ACCUM START IN #2 DATA WORD TAD E /A*E MULTY 3 TAD B /B*D SAVE TAD D MULTY 3 TAD E /B*E MULTY 4 DCA DATUM-5 /JMP DMDONE 3-WORD DCA DATUM-6 TAD F /A*F SAVE TAD A MULTY 4 TAD B /B*F MULTY 5 TAD C /C*D SAVE TAD D MULTY 4 TAD E /C*E MULTY 5 TAD F /C*F MULTY 6 /&37 DMDONE, TAD DATUM-1 /COPY RESULT DCA HORD TAD DATUM-2 DCA LORD TAD DATUM-3 DCA OVER2 JMS MULDIV NOP /DCA OVER2 3-WORD JMP I DMULT DATUM=.+6 /INTERMEDIATE STORAGE /#6-LOW ORDER /#5 /#4 /#3 /#2 /#1-HIGH ORDER *DATUM-1 MULDIV, 0 /TERMINATE MULTIPLY AND DIVIDE ISZ SIGNF /CORRECT FOR SIGN JMS I MINSKI JMS I NORMF /SHIFT LEFT NOP /ISZ OVER2 3-WORD JMP I MULDIV FLDV, TAD AC1H /4:DIVIDE SNA CLA ERROR2 /DIVISION BY ZERO TAD EX1 /SUBTRACT EXPONENTS+1 CMA IAC IAC JMS SIGN /SET UP SIGNS SMA CLA JMS I MINI /NEGATE DIVISOR JMS I DIVIDE /DIVIDE JMS MULDIV JMP I .+1 FPNT+1 /&38 /THIS SUBROUTINE PREPARES MULTIPLY AND DIVIDE /FOR ANY COMBINATION OF SIGNED ARGUMENTS AND FOR ZERO /THE RESULT OF EITHER IS ZERO IF FLAC = 0 /RESULT OF MULTIPLY IS ZERO IF EITHER IS ZERO; /DIVISION BY ZERO IS CHECKED BERFORE THIS /ROUTINE IS CALLED /THE CALLING AC CONTAINS AN UPDATE VALUE FOR THE /EXPONENT, THE RETURNING AC CONTAINS THE SIGN OF /THE ARGUMENT FOR FURTHER TESTING BY EACH ROUTINE. SIGN, 0 /TEST AND SAVE SIGN OF RESULT TAD EXP /COMPUTE NEW EXP FOR MUL-DIV. DCA EXP CLL CML RAR /LOAD 4000 TO XOR THE SIGN BITS AND HORD TAD AC1H SMA CLA /RESULT MAY BE ZERO CMA DCA SIGNF /+=-1;-=0 TAD HORD SNA JMP I REVIT /ANSWER IS ZERO SPA CLA /TAKE ABSOLUTE VALUE OF FLAC JMS I MINSKI TAD AC1H SNA /RESULT OF EITHER MAY BE ZERO JMP I REVIT JMP I SIGN MINI, MINUS2 REVIT, ZERO NORMF, DNORM DIVIDE, DUBDIV SAVE=DCA I . MP2 MULTY=JMS I . MP4 A=HORD B=LORD C=OVER2 D=AC1H E=AC1L F=OVER1 /&39 /THIS IS THE LIBRARY HEAD LIB, SPNOR /IGNORE SPACES DCA GOSWIT /I.E. TO "PROC" FOR REST OF LINE CIF CDF L JMP I LIBLOW TAD JMPGOS /RETURN TO APPROPRIATE ROUTINE TAD GOSWIT DCA GOSWIT GOSWIT, JMP I .+1 PROC START1 LGOSUB GOTO+1 LIBLOW, LOWLIB JMPGOS, JMP I GOSWIT+1 XINTEG, 0 JMS I INTEGE CIF CDF L JMP I XINTEG *7200 MP4, 0 /SINGLE PREC,UNSIGNED "MULTY" SNA JMP I MP4 /NO RESULT ADDED DCA MP1 DCA MP5 TAD THIR DCA MP3 CLL /&40 MP6, TAD MP1 RAR DCA MP1 TAD MP5 SNL JMP .+3 CLL TAD MP2 RAR DCA MP5 /SAVE HI ORDER ISZ MP3 JMP MP6 TAD MP1 /CORRECT LO ORDER RAR DCA MP3 TAD I MP4 /PICKUP SCALE FACT. CIA TAD DATUMA DCA MP1 TAD MP3 /LO ORDER CLL TAD I MP1 /ACCUMULATE DCA I MP1 ISZ MP1 RAL TAD MP5 TAD I MP1 DCA I MP1 SNL JMP I MP4 /NO CARRY ISZ MP1 ISZ I MP1 JMP I MP4 JMP .-3 /CARRY AGAIN DATUMA, DATUM MP5, 0 /PRODUCT MP1, 0 /MULTIPLIER MP3, 0 MP2, 0 /MULTIPLICAND THIR, -14 /12 BITS MIF, -43 /-27 3-WORD /&41 DUBDIV, 0 /2 OR 3 PRECISION DIVIDE DCA MP4 DCA MP1 TAD MIF /INIT BIT COUNTER DCA MP3 SKP DV3, JMS I DOUBLE /SHIFT FLAC LEFT CLL TAD OVER1 /----FROM HERE 4-WORD TAD OVER2 DCA MP5 RAL TAD AC1L /COMBINE ONE POSITION AND TAD LORD DCA MP2 /SAVE RESULT RAL TAD HORD /ADD OVERFLOW TAD AC1H SNL /SKIP IF OVERFLOW JMP .+6 DCA HORD /UPDATE FLAC TAD MP5 DCA OVER2 TAD MP2 DCA LORD CLA /CLEAR ACCUMULATOR TAD MP1 /SAVE OVERFLOW BITS CIRCULARLY RAL DCA MP1 TAD MP4 RAL DCA MP4 TAD DNORM RAL /EXTRA FOR 4-WORD DCA DNORM ISZ MP3 /TEST FOR END OF DIVIDE JMP DV3 TAD DNORM DCA HORD TAD MP4 DCA LORD TAD MP1 DCA OVER2 JMP I DUBDIV /&41 DNORM, 0 /SUB TO NORMALIZE JMS I ABSOL3 JMS TEST4 TAD HORD SNA /IS MANT.=0? TAD OVER2 SNA TAD LORD SNA CLA JMP EXIT3 TAD HORD RAL CLL SPA CLA /WILL SHIFT TOO FAR? JMP .+6 JMS I DOUBLE CMA CLL TAD EXP DCA EXP JMP .-10 JMS I RESOL3 JMS TEST4 /DON'T LEAVE 4000 JMP I DNORM EXIT3, DCA EXP JMP I DNORM TEST4, 0 /TEST FOR 4000 TAD HORD SPA CIA SPA CLA JMS I XRAR2 /SHIFT BACK JMP I TEST4 XRAR2, DIV2 ABSOL3, ABSOLV RESOL3, RESOLV PAGE /&42 /FLOATING SQUARE ROOT FUNCTION XSQRT, FINT FPUT FPAC1 /VALUE FEXT /NEWTON'S METHOD IS USED GETSGN SPA CLA ERROR2 /NUMBER IS NEGATIVE = IMAGINARY ROOTS TAD EXP /LINK =0 FROM FINT SPA /MATCH THE SIGN WITH LINK BIT CML RAR DCA ITER1 /MAKE FIRST APPROXIMATION SZL /TEST LSB OF EXP ISZ ITER1 NOP TAD SQCON1 DCA ITER1+1 DCA ITER1+2 DCA ITER1+3 TAD FPAC1+1 SNA TAD FPAC1+2 SNA CLA JMP SQEND /NUMBER = 0 CLCU, FINT FGET FPAC1 FDIV ITER1 FADD ITER1 FEXT /&43 CLA CMA TAD EXP DCA EXP TAD EXP CMA IAC TAD ITER1 SZA CLA /ARE EXPONENTS EQUAL? JMP ROOTGO /NO TAD HORD /ARE HIGH ORDER MANTISSAS EQUAL? CMA IAC TAD ITER1+1 SZA CLA JMP ROOTGO /NO TAD LORD CMA IAC TAD ITER1+2 /DO LOW ORDER MANTISSAS AGREE? SMA CMA IAC /WITHIN ONE BIT? IAC SMA CLA POPJ ROOTGO, FINT FPUT ITER1 FEXT JMP CLCU SQEND, DCA EXP POPJ SQCON1, 3015 BUFFER=. ITER1, 0 0 0 0 FPAC1, 0 0 0 BUFFER+13 /&44 *7510 FLTZER, 0 0 0 0 FLARG, 0 0 0 0 FNTABF=. CDF L XABS /ABS -ABSOLUTE VALUE CDF L XSGN /SGN -REAL SIGN FUNCTION CDF P XINT /ITR -INTEGER PART CDF P FRAN /RAN -RANDOM NUMBER CDF P ARTN /ATN - CDF P FEXP /EXP -EXPO FUNCTIONS CDF P FLOG /LOG - CDF P FSIN /SIN -TRIG FUNCTIONS CDF P FCOS /COS - CDF P XSQRT /SQT -SQUARE ROOT CDF P FIN /INP -CHAR INPUT CDF P FOUT /OUT -CHAR OUTPUT CDF P FIND /IND -FIND A CHAR CDF P ERCALL /T CDF P ERCALL /U CDF P ERCALL /V CDF P ERCALL /W CDF L XCOM /(F)X:ARRAY CDF P ERCALL /Y CDF P ERCALL /Z PAGE > IFNZRO FLTLST <XLIST>