/23-BIT EXTENDED FUNCTIONS /1-31-72 R BEAN /COPYRIGHT 1972 DIGITAL EQUIPMENT CORPORATION,MAYNARD, MASS. 01754 /DEC-08-NFPPA-A VERSION 1 EXP=44 HORD=45 LORD=46 FIXFLT=5500 *FIXFLT /******FIX****** /ROUTINE TO FIX ANY FLOATING NUMBER IN FAC BETWEEN -2047 AND +2047 TO /A TWELVE BIT INTEGER AND LEAVE RESULT IN EXP (LOC 44) FFIX, 0 CLA TAD EXP /FETCH EXPONENT SZA SMA /IS NUMBER <1? JMP .+3 /NO-CONTINUE ON FTRPRT, CLA JMP FIXDNE+1 /YES-FIX IT TO ZERO TAD M13 /SET BINARY POINT AT 11 SNA /PLACES TO RIGHT OF CURRENT POINT? JMP FIXDNE /NO-NUMBER IS ALREADY FIXED THEN. SMA /YES-IS NUMBER TOO LARGE TO FIX? JMP I OTRAPA /YES-TAKE OVERFLOW TRAP DCA EXP /NO-SET SCALE COUNT FIXLP, CLL /0 IN LINK TAD HORD /GET HIGH MANTISSA SPA /IS IT <0? CML /YES-PUT A 1 IN LINK RAR /SCALE RIGHT DCA HORD /SAVE ISZ EXP /DONE YET? JMP FIXLP /NO FIXDNE, TAD HORD /YES-ANSWER IN AC DCA EXP /RETURN WITH ANSWER IN 44 JMP I FFIX /RETURN M13, -13 /-11 DECIMAL C13, 13 /11 DECIMAL OTRAPA, FTRP1 /ADDRESS OF VECTOR FOR OVERFLOW TRAP /******FLOAT****** /ROUTINE TO FLOAT ANY INTEGER IN EXP (LOC 44) INTO FAC FFLOAT, 0 TAD EXP DCA HORD /PUT NUMBER IN HI MANTISSA DCA LORD /CLEAR LOW MANTISSA TAD C13 /11(10) INTO EXPONENT DCA EXP JMS I FNORL /NORMALIZE JMP I FFLOAT /RETURN FNORL, FFNOR /LINK TO NORMALIZE ROUTINE *5000 /******SINE****** SIN, 0 JMS NHNDLE /IF X<0,NEGATE X AND SET NFLAG JMS I FMPYL /X*2/PI TOVPI JMS FRACT /SAVE X IN TEMP1,THE INTEGER PART OF X IN NUM,AND GET FRACTIONAL PART IN FAC TAD NUM /GET INTEGER PART OF (2/PI)*X AND C3 /ISOLATE BITS 10,11 TAD JMPI DCA .+1 /MAKE JUMP TO ARGUMENT REDUCING ROUTINE JMP . /AND ADJUST ARG ACCORDING TO QUADRANT OF X JMPI, JMP I .+1 POLYSN /X IN QUAD1,SIN(X)=SIN(X) QUAD2 /X IN QUAD2,SIN(X)=SIN(1-X) QUAD3 /X IN QUAD3,SIN(X)=SIN(-X) QUAD4 /X IN QUAD4,SIN(X)=SIN(X-1) QUAD2, JMS I FSUB1L /1-X ONE JMP POLYSN /CALCULATE SIN(1-X) QUAD3, JMS I FNEGL /-X JMP POLYSN /CALCULATE SIN(-X) QUAD4, JMS I FSUBL /X-1 ONE POLYSN, JMS I FPUTL /SAVE X TEMP1 JMS I FSQRL /U=X**2 JMS I FPUTL /SAVE U TEMP2 JMS I FMPYL /A7*U SINA7 JMS I FADDL /A5+A7*U SINA5 JMS I FMPYL /A5*U+A7*U**2 TEMP2 JMS I FADDL /A3+A5(U)+A7(U**2) SINA3 JMS I FMPYL /A3(U)+A5(U**2)+A7(U**3) TEMP2 JMS I FADDL /A1+A3(U)+A5(U**2)+A7(U**3) SINA1 JMS I FMPYL /A1(X)+A3(X**3)+A5(X**5)+A7(X**7) TEMP1 JMS NCHK /IF NFLAG IS SET,SET SIN(X)=-SIN(X) JMP I SIN /FAC=SIN(X) /******COSINE****** /USES SIN ROUTINE TO CALCULATE COS(X) COS, 0 JMS I FADDL /COS(X)=SIN(PI/2+X) PIOV2 JMS SIN JMP I COS /RETURN FGETL, FFGET FADDL, FFADD FMPYL, FFMPY FPUTL, FFPUT FDIVL, FFDIV FSUB1L, FFSUB1 FNEGL, FFNEG FSUBL, FFSUB FSQRL, FFSQ FIXL, FFIX FLOATL, FFLOAT FDIV1L, FFDIV1 C3, 3 TEMP1, 0 0 0 TEMP2, 0 /TWO TEMP STORAGE BLOCKS FOR FUNCTIONS 0 0 ONE, 1 /1 2000 0 /ROUTINE TO SEPERATE THE INTEGER AND FRACTIONAL PARTS OF FAC /ORIGINAL FAC IS SAVED IN TEMP1,THE INTEGER PORTION OF FAC IS /SAVED AT NUM,AND THE FRACTIONAL FORTION OF THE FAC IS LEFT IN THE FAC FRACT, 0 JMS I FPUTL /SAVE X TEMP1 JMS I FIXL /INTEGER PORTION OF X TAD EXP DCA NUM /SAVE FIXED FORTION OF X JMS I FLOATL /FAC=FLOAT(FIX(X)) JMS I FSUB1L /FAC=X-INT(X)=FRACTION (X) TEMP1 JMP I FRACT /RETURN /ROUTINE TO CHECK IF FAC<0; IF IT IS,FAC IS NEGATED AND NFLAG IS /SET TO 1 NHNDLE, 0 TAD HORD /FETCH HIGH ORDER MANTISSA SMA CLA /IS IT <0? JMP NFLGST /NO-CLEAR NFLAG JMS I FNEGL /YES-NEGATE FAC IAC /AND SET NFLAG NFLGST, DCA NFLAG JMP I NHNDLE /ROUTINE TO NEGATE FAC IF NFLAG IS NOT =0 NCHK, 0 /LOC ALSO USED FOR TEMP STORAGE TAD NFLAG SZA CLA /IS NFLAG=0? JMS I FNEGL /NO-NEGATE FAC JMP I NCHK /YES-RETURN NUM=NCHK /******EXPONENTIAL****** EXPON, 0 /LOC USED FOR TEMP STORAGE BY SIN,ARCTAN JMS I FMPYL /Y=XLOG2(E) LOG2E JMS FRACT /GET FRACTIONAL PART OF Y JMS I FMPYL /(FRACTION(Y))*(LN2/2) LN2OV2 JMS I FPUTL /SAVE Y TEMP1 JMS I FSQRL /Y**2 JMS I FADDL /B1+Y**2 EXPB1 JMS I FDIV1L /A1/(B1+Y**2) EXPA1 JMS I FADDL /A0+A1/(B1+Y**2) EXPA0 JMS I FSUBL /A0-Y+A1/(B1+Y**2) TEMP1 JMS I FPUTL /SAVE TEMP2 JMS I FGETL /GET Y TEMP1 ISZ EXP /MULT. BY 2=2Y NOP JMS I FDIVL /2Y/(A0-Y+A1/(B1+Y**2)) TEMP2 JMS I FADDL /1+2Y/(AO-Y+A1/(B1+Y**2)) ONE JMS I FSQRL /[1+2Y/(A0-Y+A1/(B1+Y**2))]**2=EXP(Y) TAD NUM TAD EXP /EXP(X)=(2**N)(EXPY) DCA EXP JMP I EXPON /FAC=EXPON(X) NFLAG=EXPON /CONSTANT THAT WOULDN'T FIT ELSEWHERE TOVPI, 0 /.6366198 2427 6302 *SIN+200 /******ARC TANGENT****** ATAN, 0 JMS I NHNDLL /IF X<0,SET NFLAG AND NEGATE JMS I FPUTM /SAVE X TEMP1 JMS I FSUBM /X-1 ONE TAD HORD /GET HI MANTISSA SPA CLA /WAS X>1? JMP ARGPOL /NO-CLEAR GT1FLG JMS I FGETM /YES-ATAN(X)=PI/2-ATAN(1/X) ONE JMS I FDIVM /1/X TEMP1 JMS I FPUTM TEMP1 IAC /SET GT1FLG ARGPOL, DCA GT1FLG JMS I FGETM /GET X OR 1/X TEMP1 JMS I FSQRM /Y**2 JMS I FPUTM /SAVE TEMP2 JMS I FADDM /Y**2+B3 ATANB3 JMS I FDIV1M /A3/(Y**2+B3) ATANA3 JMS I FADDM /B2+A3/(Y**2+B3) ATANB2 JMS I FADDM /Y**2+B2+A3/(Y**2+B3) TEMP2 JMS I FDIV1M /A2/(Y**2+B2+A3/(Y**2+B3)) ATANA2 JMS I FADDM /B1+A2/(Y**2+B2+A3/(Y**2+B3)) ATANB1 JMS I FADDM /Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3)) TEMP2 JMS I FDIV1M /A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3))) ATANA1 JMS I FADDM /B0+A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3))) ATANB0 JMS I FMPYM /ATAN(Y)=X*(B0+A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3)))) TEMP1 TAD GT1FLG /WAS X>1? SNA CLA JMP NGT /NO-TEST IF X<0? JMS I FSUB1M /ATAN(X)=PI/2-ATAN(1/X) PIOV2 NGT, JMS I NCHKL /IF NFLAG SET,NEGATE FAC JMP I ATAN /FAC=ATAN(X) NHNDLL, NHNDLE NCHKL, NCHK /******NAPERIAN LOGARITHM****** GTFLG=ATAN LOG, 0 TAD HORD SPA SNA /X<0 OR X=0? JMP I ARTRAP /YES-TAKE ILLEGAL ARGUMENT TRAP CLL RTL SNA /NO-HORD=2000? TAD EXP /YES-EXP=1? CMA IAC IAC SNA TAD LORD /YES-LORD=0? SZA CLA JMP POLYNL /NO-ARG IS LEGAL AND NOT 1 DCA EXP DCA LORD LTRPRT, DCA HORD JMP I LOG /YES-LOG(1)=0 POLYNL, TAD EXP DCA GTFLG /SAVE EXPONENT FOR LATER DCA EXP /ISOLATE MANTISSA IN FAC JMS I FPUTM /SAVE F TEMP1 JMS I FADDM /F+SQR(.5) SQRP5 JMS I FPUTM /SAVE TEMP2 JMS I FGETM TEMP1 JMS I FSUBM /F-SQR(.5) SQRP5 JMS I FDIVM /Z=F+SQR(.5)/F-SQR(.5) TEMP2 JMS I FPUTM TEMP1 JMS I FSQRM /Z**2 JMS I FPUTM TEMP2 JMS I FMPYM /C5(Z**2) LOGC5 JMS I FADDM /C3+C5(Z**2) LOGC3 JMS I FMPYM /C3(Z**2)+C5(Z**4) TEMP2 JMS I FADDM /C1+C3(Z**2)+C5(Z**4) LOGC1 JMS I FMPYM /C1(Z)+C3(Z**3)+C5(Z**5) TEMP1 JMS I FSUBM /C1(Z)+C3(Z**3)+C5(Z**5)-1/2=LOG2(F) ONEHAF JMS I FPUTM /SAVE LOG2(F) TEMP2 TAD GTFLG /I DCA EXP /SET UP FLOAT JMS I FLOATM JMS I FADDM /I+LOG2(F) TEMP2 JMS I FMPYM /[I+LOG2(F)]*LOGE(2)=LOGE(X) LN2 JMP I LOG /FAC=LN(X) GT1FLG=LOG FPUTM, FFPUT FMPYM, FFMPY FADDM, FFADD FDIVM, FFDIV FDIV1M, FFDIV1 FSUBM, FFSUB FSUB1M, FFSUB1 FSQRM, FFSQ FLOATM, FFLOAT FGETM, FFGET ARTRAP, FTRP3 /CONSTANTS USED BY VARIOUS FUNCTIONS SINA1, 1 /1.5707949 3110 3747 SINA3, 0 /-.64592098 5325 1167 SINA5, 7775 /.07948766 2426 2466 SINA7, 7771 /-.004362476 5610 3164 PIOV2, 1 /1.5707963 3110 3756 LOG2E, 1 /1.442695 2705 2434 LN2OV2, 7777 /.34657359 2613 4415 EXPB1, 6 /60.090191 3602 7054 EXPA1, 12 /-601.80427 5514 3104 EXPA0, 4 /12.015017 3001 7301 ATANB0, 7776 /.17465544 2626 6157 ATANA1, 2 /3.7092563 3553 1071 ATANB1, 3 /6.762139 3303 670 ATANA2, 3 /-7.10676 4344 5267 ATANB2, 2 /3.3163354 3241 7554 ATANA3, 7777 /-.26476862 5703 4040 ATANB3, 1 /1.44863154 2713 3140 SQRP5, 0 /.7071068 2650 1170 LOGC1, 2 /2.8853913 2705 2440 LOGC3, 0 /.9614706 3661 566 LOGC5, 0 /.59897865 2312 5525 ONEHAF, 0 /.5 2000 0 LN2, 0 /.6931472 2613 4415 FFSIN=SIN FFCOS=COS FFATN=ATAN FFLOG=LOG FFEXP=EXPON PAUSE