/PFLOTB -- PS/8 FOCAL FLOATING POINT PACKAGE /AS OF OCTOBER 4, 1974, PFLOTB IS IDENTICAL WITH PFLOTA /COPYRIGHT 1971 DIGITAL EQUIPMENT CORPORATION / MAYNARD, MASSACHUSETTS 01754 / IFNDEF T *4434 JMP I .+5 *4441 4300 /REMOVE /SPECIAL VERSION TO REMOVE FSQT,FSGN ONLY *4300 DATUMA-12 DMULT+12 DMULT4+3 *4303 TAD .-2 SZA CLA JMP I .+2 SKP PUSHA-DMPSW DCA THISLN+6 DCA THISLN+12 DCA THISLN-1 TAD .+3 DCA I .+3 JMP I .-6 PCHECK+1 LOOP01-TERMS+5 IFNDEF T /PAGE ZERO OF THE /FLOATING POINT ARITHMETIC INTERPRETER FOR FOCAL FIELD 1 *40 EX1, 0 /OPERAND STORAGE AC1H, 0 AC1L, 0 OVER1, 0 FLAC=. /FLOATING ACCUMULATOR EXP, 0 /F.A. HORD, 0 LORD, 0 OVER2, 0 SIGNF, 0 /FLOATIN SIGN MINSKI, ACMINS /NEGATE FLAC SUBROUTINE FISW, 0 /OUTPUT FORMAT INTEGER,FIX /FIX FLAC /FUNCTIONS CONTAINED IN THIS SECTION /ARTN /FEXP /FLOG /FSIN /FCOS /XSQRT /FLOATING POINT PACKAGE - EXPONENTIAL GETSGN=TAD FLAC+1 RETURN=JMP I EFUN3I *4600+20 FEXP, GETSGN /TAKE ABSOLUTE VALUE SPA CLA JMS I NEGP DCA T3 /C(SIGN)=-1 IF I X2<0 FINT FMUL LG2E FPUT I X2 FEXT JMS I INTEGER /TAKE INTEGER PART DCA FLAG2 /SAVE LOW 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 FLAC DCA FLAC ISZ T3 RETURN FINT FPUT I X2 FGET ONE FDIV I X2 FEXT RETURN /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 /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 /------------------------------------------------------------ /------------------------------------------------------------ /FLOATING POINT ARC TANGENT *5000 ARTN, GETSGN /TAKE ABSOLUTE VALUE SPA CLA JMS FNEG DCA T3 FINT FPUT I X1 FSUB I CON1 FEXT GETSGN SPA CLA JMP GO /LESS THAN ONE FINT FGET I CON1 FDIV I X1 FPUT I X1 FEXT CLA CMA GO, DCA FLAG1 /SIGN FLAG OF RESULT JMP I .+1 /CALL ALGORITHM ARCALG ARCRTN, ISZ FLAG1 /RETURN HERE JMP I EXIT1 FINT FPUT I X1 FGET I PI2 FSUB I X1 FEXT JMP I .+1 EXIT1, EXIT2 /CONSTANTS FOR ARCTANGENT X1, X PI2, PIOT CON1, ONE FLOG, GETSGN /FLOATING LOGARITHM SNA ERROR3 /ZERO ARGUEMENT FOR LOG SPA CLA ERROR3 /NEGATIVE ARGUMENT FINT FPUT I TEM FSUB I CON1 FEXT GETSGN SNA RETURN SMA CLA JMP STARTL FINT FGET I CON1 FDIV I TEM FPUT I TEM FEXT CLA CMA STARTL, DCA T3 TAD P13 DCA FLAC CMA TAD I TEM DCA FLAC+1 DCA FLAC+2 DCA FLAC+3 IAC DCA I TEM FINT FMUL LOG2 FPUT I X1 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 I X1 FEXT JMP I EXIT1 L1, 0000 3777 7742 L2, 7777 4000 4100 L3, 7777 2517 0310 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 /------------------------------------------------------------ /------------------------------------------------------------ /FLOATING POINT SINE AND COSINE *5200 FCOS, FINT /COS(X)=SIN(PI/2-X) FPUT X FGET PIOT FSUB X FEXT FSIN, GETSGN SMA SZA CLA JMP MOD GETSGN SMA CLA RETURN /YES SIN(0)=0 JMS I MINSKI CMA /NO:SIN(-X)=-SIN(X) MOD, DCA T3 /REDUCE X MODULO 2 PI FINT FDIV TWOPI FPUT XSQR FEXT JMS I INTEGER FINT FNOR FPUT X FGET XSQR FSUB X FMUL TWOPI FPUT X FSUB PI /X 0 ? JMP .+5 /YES CLA CMA /NO, TAD T1 DCA DECP /MAKE D = F-1 CMA TAD T3 /COMPARE DECIMAL EXPONENT SMA / F-D > E? CLA /NO, ROUND OFF TO .F PLACES TAD T1 /YES SPA / D+E < 0 ? JMP FPRNT-2 /YES, NO ROUNDING NEEDED, GO TO PRINT TAD MD /NO, ROUND TO D+E PLACES, SMA /TO A MAXIMUM OF D PLACES CLA 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 /SET UP COUNT OF MAXIMUM NUMBER DCA T2 /OF CARRIES ALLOWABLE TAD K4 /LITTLE EXTRA ON FIRST DIGIT. RET, ISZ I PLCE /ADD 1 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 /BEGINNING OF BUFFER REACHED? JMP DECR /NO, DECREMENT BUFFER ADDRESS AND REPEAT ISZ I PLCE /YES, SET MANTISSA TO 0.1 ISZ T3 /COMPENSATE BY INCREMENTING EXPONENT CLA FPRNT, TAD FISW /AUTO-INDEX REGISTER ALREADY SET. - *PRINT* SNA CLA / F = 0 ? JMP FLOUT /YES, OUTPUT AS FLOATING NUMBER TAD FCOUNT TAD T3 SMA SZA / E > F ? JMP FLOUT-1 /YES,CONVERT TO E FORMAT TAD DECP SMA / E < F-D ? CLA /NO, TAKE P = E CIA /YES, TAKE P = F-D TAD T3 CIA DCA T1 /SET UP MINUS P BACK, TAD T3 /PRINT DD.DDD TAD T1 SNA CLA / P = E ? JMP DIG /YES, PRINT DIGIT TAD T1 /NO, IAC SPA CLA / P > 1 ? TAD M20 /YES, TAKE SPACE (240-260); OTHERWISE ZERO IN, JMS OUTA /PRINT CHARACTER ISZ T1 /P CHARACTERS PRINTED? JMP BACK /NO TAD PER /YES, PRINTC /PRINT DECIMAL POINT JMP BACK DECR, CMA /BACKUP TO TOP OF BUFFER. TAD PLCE DCA PLCE JMP RET K4, 4 MD, -DIGITS RND2, DIGITS+1 OM12, -12 BUFST, SADR OPUT, OUTDG DECP, 0 /MODIFIABLE LOCATIONS SCOUNT, 0 FCOUNT, 0 PLCE=. OUTA, 0 /MODIFIED REGISTERS. JMS I OPUT /PRINT CHARACTER ISZ FCOUNT /F CHARACTERS PRINTED? JMP I OUTA /NO--RETURN-- JMP I TGO /YES, NUMBER FINSHED DIG, CMA TAD T3 /REDUCE E, BY 1 DCA T3 ISZ SCOUNT /ARE ALL SIG. FIGS. 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 BUFFER JMP IN /DO FLOATING OUTPUT CLA /IF OUTPUT TOO LARGE, FLOUT, JMS I OPUT /PRINT "0" TAD PER PRINTC /PRINT "." ISZ TGO /SECOND RETURN TAD I FLTXR /TAKE NEXT DIGIT FROM BUFFER JMS OUTA /PRINT IT ISZ SCOUNT /TEST FOR END OF INPUT JMP .-3 /AND REPEAT CMA DCA SCOUNT /OUTPUT EXTRA ZEROS. JMP .-5 ABSOLV, 0 TAD HORD DCA SIGNF TAD HORD SPA CLA JMS I MINSKI JMP I ABSOLV /--RETURN-- /------------------------------------------------------------ /------------------------------------------------------------ /DOUBLE PRECISION DECIMAL-BINARY /INPUT AND CONVERSION FOR + OR - XXX... *5600 DECONV, 0 DCA LORD DCA EXP /ZERO THE EXPONENT AND DCA HORD /INITIALIZE FLOATING AC. DCA OVER2 DCA DNUMBR DCA SIGNF TAD CHAR /ALLOW KEYBOARD SIGN CHECKS. TAD MPLUS SNA JMP .+6 /+SIGN; GET NEXT TAD M2 /CHECK - 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 /--RETURN-- DECON, 0 TAD CHAR /TEST LEAD CHARACTER FOR TERMINATOR TAD MINE SNA CLA JMP I DECON /E--RETURN-- TESTN JMP I DECON /.--RETURN-- JMP DTST /OTHER TAD SORTCN /N DSAVE, DCA DIGIT /YES JMS MULT10 /REMAIN MUST =0 SINCE OVERFLOW IS CHECKED ISZ DNUMBR /COUNT DIGITS SZA CLA ERROR2 /INPUT-OVERFLOW ERROR JMS I XINPUT JMP DECON+1 /CONTINUE DTST, TAD CHAR /ALLOW A-Z TAD MINUSA SPA CLA JMP I DECON /--RETURN-- TAD CHAR TAD MINUSZ SZA SMA CLA JMP I DECON /USE SIX BITS OF ASCII--RETURN-- TAD CHAR AND P77 JMP DSAVE MINE, -305 /(7532)- FOR AMPERSAND MINUSZ, -332 MPLUS, -253 MSPACE, -240 XINPUT, INPUT MULT10, 0 /ROUTINE TO MULTIPLY FLAC BY TEN (10) TAD OVER2 DCA OVER1 TAD LORD /DOUBLE PRECISION WORD DCA AC1L /BY TEN (DECIMAL) TAD HORD /REMAIN=REMAINDER DCA AC1H DCA REMAIN /CLEAR OVERFLOW WORD JMS MULT2 /CALL SUBROUTINE TO JMS MULT2 /MULTIPLY BY TWO 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--RETURN-- REMAIN, 0 DIGIT, 0 /STORAGE FOR DIGIT DNUMBR, 0 /=NUMBER OF DIGITS MULT2, 0 /MULTIPLY OVER2, LORD, HORD BY 2 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 /--RETURN-- 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 /WITH OVERFLOW DCA REMAIN JMP I DUBLAD /--RETURN-- 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 /--RETURN-- JMP I DIV1 /--RETURN-- /------------------------------------------------------------ /------------------------------------------------------------ *6000 /FLOATING OUTPUT CONVERSION ROUTINE FLOUTP, 0 TAD PEQ PRINTC /(CLA)_ TO SUPPRESS "=" TAD HORD /NUMBER>0?? SMA CLA TAD SMSP /PRINT "-" OR A SPACE. TAD SMIN PRINTC JMS I ABSOL2 FGO2, DCA T3 /INITIALIZE DECIMAL EXPONENT TAD EXP /IS EXP 0 TO 4? SPA JMP FGO3 /TOO LARGE:MULTIPLY BY 1/10 SZA TAD M4 SPA SNA CLA JMP FGO4 FINT FMUL I PPTEN FEXT IAC TAD T3 JMP FGO2 FGO3, FINT FMUL I TENPT FEXT CMA JMP .-6 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 EXPONENT 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--RETURN-- TAD CHRT /PRINT "E" PRINTC /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 /--RETURN-- PRNTI, PRNT CHRT, 305 /E (0246) - FOR AMPERSAND SMSP, 240-255 / PEQ, 240 /CHANGED FROM "=" TO SPACE SMIN, 255 M144, -144 /-100 C144, 0144 /+100 M4, -4 FM12, -12 DCOUNT, -DIGITS-1 /NUMBER OF DIGITS OUTPUT 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 OUTDG, 0 /OUTPUT ONE DIGIT TAD C260 PRINTC JMP I OUTDG /--RETURN-- /USED BY 8K /------------------------------------------------------------ /------------------------------------------------------------ /FLOATING POINT INPUT *6200 FLINTP, 0 /IF C(AC) = 0, USE CHAR SZA CLA /IF C(AC) NON-ZERO , GET NEXT JMS I XIN /GET FIRST CHAR TAD CHAR /IGNORE LEADING SPACES TAD M240 SNA CLA JMP .-4 JMS I DPCVPT /READ FIRST DIGIT GROUP TAD CHAR /AND SET "SIGNF" TAD MPER SZA CLA /ENDED BY PERIOD? JMP FIGO1 JMS I XIN /YES, READ 2AND 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 FPUT I PT1 /SAVE NUMBER FEXT TAD CHAR TAD MINUSE SZA CLA /"E" READ IN? 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 DCA T3 /OF LAST DIGIT /COMPENSATE FOR DECIMAL EXPONENTS ENDFI, FINT /RESTORE MANTISSA FGET I PT1 FEXT TAD T3 /TEST DECIMAL EXPONENT SNA JMP I FLINTP /FINISHED--RETURN-- 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 /MULTIPLY BY 10 FPUT I PT1 FEXT CMA TAD T3 DCA T3 JMP ENDFI+3 TEN, 0004 2400 0000 0000 PTEN, 7775 3146 3146 /(3147) - FOR 3-WORD 3150 MINUSE, -305 /(7532) - FOR AMPERSAND DPCVPT, DECONV DCONP, DECON RESOL5, RESOLV DPN, DNUMBR XIN, INPUT INORM, DNORM P43, 43 /END OF FLOATING POINT INPUT /7 FREE /USED BY H.S. READER /------------------------------------------------------------ /------------------------------------------------------------ *6400 / FLOATING-POINT INTERPRETER FOR FOCAL. FPNT, 0 CLA CLL NOP /(DCA OVER2) - FOR 3-WORD NOP /(DCA OVER1) - FOR 3-WORD. TAD I FPNT /GET NEXT INSTRUCTION SNA JMP I FPNT /FAST EXIT--RETURN-- DCA JUMP TAD JUMP AND C200 /GET PAGE BIT SNA CLA /PAGE ZERO? JMP .+3 /YES TAD P7600 /NO AND FPNT /C(FPNT)0-4 CONTAINS PAGE BITS DCA ADDR TAD P177 /GET 7 BIT ADDRESS 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,IE OPCODE SNA JMP FLGT TAD TABLE /LOOKUP IN TABLE DCA JUMP TAD I JUMP SNA JMP FLPT DCA JUMP TAD CEX1 /SAVE FLOATING ARGUEMENT,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 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' ADDRESS 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 ALIGNMENT IS POSSIBLE JMS I RAR2 /TRIPLE PRECISION ADDDITION 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. /INTERPRETIVE POWER NOP /3 FREE LOCATIONS ************ NOP NOP ZERO, DCA EXP /YES DCA HORD DCA LORD DCA OVER2 JMP FPNT+1 FLEX, 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) - FOR 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 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 /--RETURN-- ALIGN, 0 /SUBROUTINE TO ALIGN TAD HORD /BINARY POINTS SNA TAD LORD /IS MANTISSA ZERO? SNA CLA JMP NOX1 /YES, RESULT=OPERAND TAD AC1H /NO,IS OPERAND ZERO? SNA TAD AC1L SNA TAD OVER1 SNA CLA JMP I ALIGN /YES--RETURN-- TAD EX1 CMA IAC TAD EXP SNA /ARE EXPONENTS EQUAL? JMP ADONE /YES 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 ASHFT, CMA TAD EX1 DCA EX1 JMS I TAG1 ISZ AMOUNT JMP .-2 ADONE, ISZ ALIGN JMP I ALIGN /--RETURN-- NOX, TAD EX1 /MISSION IMPOSSIBLE! SMA CLA /CHECK FOR SIGN DIFFERENCE JMP NOX2 TAD EXP SMA CLA JMP I ALIGN /-+--RETURN-- JMP .+3 /-- NOX2, TAD EXP SMA CLA TAD ACMINS /TEMP STORAGE OF DIFFERENCE. BOTH POS EXP OR BOTH NEG. SMA SZA CLA JMP I ALIGN /OK (+-)--RETURN-- NOX1, TAD EX1 /USE LARGER DCA EXP TAD AC1H DCA HORD TAD AC1L DCA LORD TAD OVER1 DCA OVER2 JMP I ALIGN /--RETURN-- AMOUNT, 0 TAG1, DIV1 /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 ALIGNMENT DCA EX1 JMS ALIGN /DO THE ALIGNMENT 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 /--RETURN-- P27, 27 ABSOL, ABSOLV RESOL, RESOLV 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 /--RETURN-- JMP I DIV2 /--RETURN-- /------------------------------------------------------------ SPECIAL=. /INPUT CHARACTERS 337 /LEFT ARROW 377 /RUBOUT 212 /L.F. 375 /ALT MODE 214 /^L IS IGNORED IN AN "ASK" COMMAND /(A+B+C)*(D+E+F)=A*D,A*E,B*D,B*E 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 MINUS2 DCA DATUM-1 /INITIALIZE RESULT DCA DATUM-2 DCA DATUM-3 DCA DATUM-4 TAD A /A*D SAVE /STORE IN MP2 TAD D /SINGLE PRECISION MULTIPLY MULTY 2 /ACCUMULATE STARTING 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 DMULT4, DCA DATUM-5 /(JMP DMDONE)-FOR 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 DMDONE, TAD DATUM-1 /COPY RESULT DCA HORD TAD DATUM-2 DCA LORD TAD DATUM-3 DCA OVER2 JMS MULDIV NOP /(DCA OVER2) - FOR 3-WORD JMP I DMULT /--RETURN-- DATUM=.+6 /INTERMEDIATE STORAGE /#6-LOW ORDER RESULT /#5 /#4 /#3 /#2 /#1-HIGH ORDER RESULT *DATUM-1 MULDIV, 0 /TERMINATE MULTIPLY AND DIVIDE. ISZ SIGNF /CORRECT FOR SIGN JMS I MINSKI JMS I NORMF /SHIFT LEFT NOP JMP I MULDIV /--RETURN-- 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 MINUS2 /NEGATE DIVISOR JMS I DIVIDE /DIVIDE JMS MULDIV JMP I .+1 FPNT+1 /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 BEFORE 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 EXPONENT FOR MUL-DIV. DCA EXP TAD P4000 /LOAD 4000 TO XOR THE SIGN BITS AND HORD TAD AC1H SMA CLA /RESULT MAY BE ZERO CMA DCA SIGNF 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 /--RETURN-- /SIGN OF RESULT = SIGNF /+=-1 /-=0 REVIT, ZERO NORMF, DNORM DIVIDE, DUBDIV SAVE=DCA I . MP2 MULTY=JMS I . MP4 A=FLAC+1 B=FLAC+2 C=FLAC+3 D=AC1H E=AC1L F=OVER1 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 /--RETURN-- RESOLV, 0 TAD SIGNF SPA CLA JMS I MINSKI JMP I RESOLV /--RETURN-- /------------------------------------------------------------ /------------------------------------------------------------ *7200 MP4, 0 /SINGLE PRECISION, UNSIGNED MULTIPLY - "MULTY" SNA /NO RESULT ADDED IF ZERO JMP I MP4 /--RETURN-- /FOR EAE INSERT THE FOLLOWING: /7203 3206 DCA .+3 /7204 1256 TAD MP2 /7205 7425 MQL MUY /7206 0000 0 /7207 3253 DCA MP5 /7210 7501 MQA /7211 3255 DCA MP3 /7212 5227 JMP .+15 DCA MP1 /12 BITS BY 12 BITS DCA MP5 TAD THIR DCA MP3 CLL MP6, TAD MP1 RAR DCA MP1 TAD MP5 SNL JMP .+3 CLL TAD MP2 RAR DCA MP5 /SAVE HIGH ORDER RESULT ISZ MP3 JMP MP6 TAD MP1 /CORRECT LOW ORDER RESULT RAR DCA MP3 TAD I MP4 /PICKUP SCALE FACTOR CIA TAD DATUMA /COMPUTE ADDRESS DCA MP1 /TEMP TAD MP3 /LOW ORDER PART 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--RETURN-- ISZ MP1 ISZ I MP1 JMP I MP4 /--RETURN JMP .-3 /CARRY AGAIN DATUMA, DATUM MP5, 0 /PRODUCT MP1, 0 /MULTIPLIER MP3, 0 MP2, 0 /MULTIPLICAND THIR, -14 /12 BITS MIF, -43 /(-27) - FOR 3-WORD(=7751) 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 TAD OVER2 DCA MP5 RAL TAD AC1L /COMBINE ONE POSITION AND (4-WORD) 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 /--RETURN-- DNORM, 0 /SUBROUTINE TO NORMALIZE FLAC JMS I ABSOL3 JMS TEST4 TAD HORD SNA /IS MANTISSA=0? TAD OVER2 SNA TAD LORD SNA CLA JMP EXIT3 /YES TAD HORD RAL CLL SPA CLA /WILL SHIFT BE 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 /--RETURN-- EXIT3, DCA EXP /SET TO ZERO JMP I DNORM /--RETURN-- XRAR2, DIV2 TEST4, 0 TAD HORD /TEST FOR 4000 SPA CIA SPA CLA JMS I XRAR2 /SHIFT BACK JMP I TEST4 /--RETURN-- ABSOL3, ABSOLV RESOL3, RESOLV /------------------------------------------------------------ /------------------------------------------------------------ *7400 /PAGE 18 /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 IS =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 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 RETURN ROOTGO, FINT FPUT ITER1 FEXT JMP CLCU SQEND, DCA EXP RETURN SQCON1, 3015 BUFFER=. ITER1, 0 0 0 0 FPAC1, 0 0 0 BUFFER+13 /ADDRESS OF NEXT FREE LOCATION IN 10-DIGIT VERSION.