/ /POWERS.V04 /8K FORTRAN LIBRARY /COPYRIGHT 1969 /DIGITAL EQUIPMENT COPR., MAYNARD, MASS. / ENTRY IIPOW / INTEGER TO INTEGER POWER ENTRY IFPOW / INTEGER TO FLOATING POWER ENTRY FIPOW / FLOATING TO INTEGER POWER ENTRY FFPOW / FLOATING TO FLOATING POWER ENTRY EXP / E TO A POWER ENTRY ALOG / NATURAL LOGARITHM / / DUMMY LXP DUMMY N / / INTERNAL SUBROUTINE POL / / COMPUTES N TERMS OF POLYNOMIAL (NO CONSTANT TERM) / N IN AC ... X IN FLOATING AC / COEFFICIENTS START IN LOCATION WHOSE ADDRESS FOLLOWS JMS TO POL / POL2, BLOCK 1 POL, BLOCK 1 CIA DCA POL2 CALL 1,STO ARG X TAD I POL INC POL / DCA ARG1# /THIS CODE PROBABLY EXTRANEOUS / SKP ARG2, DCA ARG1# CALL 1,FAD ARG1, ARG EXS / ADDRESS STORED HERE CALL 1,FMP ARG X ISZ POL2 JMP POL1 JMP I POL POL1, TAD ARG1# TAD (3 JMP ARG2 CPAGE 17 / CANT BREAK UP THIS TABLE EXS, 1464 /7.9608942E-9 CONSTANTS FOR EXP 2142 1421 1545 /6.3578287E-7 2525 2525 1625 /4.0690103E-5 2525 2525 1704 /1.9531250E-3 0000 0000 1754 /6.25E-2 0000 0000 CPAGE 3 ONE, 2014 0000 0000 CPAGE 30 COF, 5716 /-6.4535442E-3 CONSTANTS FOR LOGS 4674 1006 1744 /3.6088494E-2 4750 6073 5756 /-9.5329390E-2 0636 0162 1765 /1.6765407E-1 2726 6023 5767 /-2.4073380E-1 5501 3543 1775 /3.3179902E-1 2360 6176 5777 /-4.9987412E-1 7767 6001 2007 /9.9999643E-1 7777 7041 CPAGE 3 ER16, 2014 /1.0644944 2040 5326 CPAGE 3 LN2, 1755 /8.6643397E-2 4271 0300 / / REPLACE THE EXPONENT BY ITS ABSOLUTE VALUE / AND REMEMBER ITS SIGN / INIT, 0 DCA N# / SAVE ADDRESS OF ARG DCA SIGN / CLEAR SIGN LOCATION TAD I N / THIS IS THE ACTUAL INTEGER POWER SMA / IS IT NEGATIVE JMP AHEAD / NO ... GOOD WE WANT IT THAT WAY CIA / COMPLEMENT IT ISZ SIGN / SET SIGN LOCATION AHEAD, DCA N / AND SAVE IT JMP I INIT / RETURN N, BLOCK 3 RSLT, BLOCK 3 SIGN, BLOCK 1 / LOCATION TO HOLD SIGN IN X, BLOCK 3 Y, BLOCK 3 / / ALOG - NATURAL LOGARITHM / / ALOG(X)=N*ALOG(2)+ALOG(M) WHERE 1/2 OR EQUAL TO M / ALOG(M)=ALTERNATING SERIES (K**I)/I WHERE K=2M-1 AND M AS ABOVE / CPAGE 4 LGER, 0114 / "ALOG" ERROR AT LOC XXXXX 707 ALOG, BLOCK 2 / ENTRY POINT CALL 1,SETERR ARG LGER TAD I ALOG / CDF TO BANK OF X DCA TEM INC ALOG# / INDEX TO ADDRESS OF X TAD I ALOG / ADDRESS OF X DCA TEM# INC ALOG# / INDEX FOR EXIT CALL 1,FAD / PLACE X IN FLOATING AC TEM, ARG 0 / ADDRESS STORED HERE TAD ACH / GET EXPONENT AND (3770 TAD (5770 / -2000 DCA TEM / N INTO TEM TAD ACH / GET M WITHOUT SIGN AND (7 TAD (2010 / 2M DCA ACH CALL 1,FSB / 2M-1 ARG ONE TAD (D8 / 8 TERMS OF SERIES JMS POL COF CALL 1,STO / ALOG(M) INTO Y ARG Y TAD TEM / GET N CALL 0,FLOT / FLOAT IT CALL 1,FMP / N *ALOG(2) ARG LN2 CALL 1,FAD / N *ALOG(2) ALOG(M)(ALOG(X) ARG Y CALL 0,CLRERR RETRN ALOG / EXIT / / EXP - E TO A POWER / / E**X=SERIES (X**I)/(I!) / IF B=E**(1/16) AND X IS BETWEEN -1 AND 1 THEN / B**X=1 SUMA(I)*(X**I) FOR I FROM I=1 TO I=5 / WHERE A(I)(1/((I!)*16**2)) / CPAGE 4 EXPER, 0530 2040 EXP, BLOCK 2 / ENTRY POINT CALL 1,SETERR ARG EXPER TAD I EXP / CDF TO BANK OF X DCA XT INC EXP# / INDEX TO ADDRESS TAD I EXP / ADDRESS OF X DCA XT# INC EXP# / INDEX FOR EXIT CALL 1,FAD / PLACE X IN FLOATING AC XT, ARG 0 / ADDRESS STORED HERE TAD ACH SZA TAD (40 / X*16 DCA ACH CALL 1,STO / Y=16X ARG Y CALL 1,FAD / EXPRESS Y AS INTEGER N AND FRACTION F ARG Y CALL 0,FIX / GET N SMA IAC DCA ALOG / ALOG=N TAD ALOG / GET F CIA CALL 0,FLOT CALL 1,FAD ARG Y TAD (5 / 5 TERMS OF SERIES JMS POL EXS CALL 1,FAD / PLUS 1 ARG ONE CALL 1,STO / GIVES B**F ARG Y CALL 1,FAD / GET B ARG ER16 CALL 1,FIPOW ARG ALOG CALL 1,FMP / B**(N+F)=(B**16X)(E**X) ARG Y CALL 0,CLRERR RETRN EXP / EXIT / / INTEGER TO INTEGER POWER / IIPOW, BLOCK 2 / ENTRY POINT DCA X / SAVE BASE TAD I IIPOW / PICK UP CDF TO ARGUMENT INC IIPOW# / INCREMENT TO ADDRESS DCA N / SAVE CDF IN A DUMMY LOC TAD I IIPOW / PICK UP ADDRESS OF ARGUMENT INC IIPOW# / INCREMENT FOR EXIT JMS INIT / PICK UP EXPONENT AND REMBER SIGN TAD SIGN / IF EXPONENT IS NEGATIVE RESULT IS ZERO SNA CLA JMP IIP1 RETRN IIPOW / RETURN WITH ZERO AC IIP1, IAC / SET RESULT=1 DCA RSLT IBACK, TAD N / DONE WHEN N EQUALS ZERO SNA JMP IDONE RAR CLL / N=N/2 DCA N SNL / IS N EVEN OR ODD JMP ILOOP / N IS EVEN TAD RSLT / N IS ODD CALL 1,MPY / RSLT=RSLT*X ARG X DCA RSLT ILOOP, TAD X / X=X*X CALL 1,MPY ARG X DCA X JMP IBACK IDONE, TAD RSLT / RESULT TO AC RETRN IIPOW / / IFPOW - INTEGER TO FLOATING POWER / / JUST FLOAT BASE AND GO TO FFPOW / IFPOW, BLOCK 2 / ENTRY POINT CALL 0,FLOT TAD IFPOW / FROM BANK DCA FFPOW / TO PROPER LOCATION TAD IFPOW# // FROM ADDRESS DCA FFPOW# TO PROPER LOC JMP ML / SNEAK INTO ROUTINE / / IIP AND FIP USE THE FOLLOWING IDENTITIES / X**(2N+1)=X*(X**2N) / X**(2N)=(X*X)**N / / / FIPOW - FLOATING POINT TO INTEGER POWER / CPAGE 4 FIPW, 0611 / "FIPW" ERROR FROM LOC XXXXX 2027 FIPOW, BLOCK 2 / ENTRY POINT CALL 1,SETERR ARG FIPW CALL 1,STO / STORE BASE ARG X TAD I FIPOW / PICK UP CDF TO ARGUMENT DCA N INC FIPOW# / INCREMENT TO ADDRESS TAD I FIPOW / PICK UP ADDRESS OF ARG INC FIPOW# / INCREMENT FOR EXIT JMS INIT / PICK UP EXPONENT AND REMEMBER ITS SIGN CALL 1,FAD / SET RSLT EQUAL TO 1 ARG ONE CALL 1,STO ARG RSLT BACK, TAD N / DONE WHEN N EQUALS ZERO SNA JMP DONE RAR CLL / N/2 DCA N SNL JMP ELOOP / N WAS EVEN CALL 1,FAD / N WAS ODD ARG RSLT CALL 1,FMP / RSLT=RSLT*X ARG X CALL 1,STO ARG RSLT TAD N SNA CLA JMP DONE ELOOP, CALL 1,FAD / X=X*X ARG X CALL 1,FMP ARG X CALL 1,STO ARG X JMP BACK DONE, TAD SIGN / WAS EXPONENT NEGATIVE% SNA CLA JMP OUT / IT WAS POSITIVE CALL 1,FAD / IT WAS NEGATIVE ... TAKE RECIPROCAL ARG ONE CALL 1,FDV ARG RSLT CALL 0,CLRERR RETRN FIPOW / EXIT OUT, CALL 1,FAD / PLACE RESULT IN FLOATING AC ARG RSLT CALL 0,CLRERR RETRN FIPOW / AND EXIT / / FFPOW- FLOATING TO FLOATING POWER / / IDENTITY USED ... X**Y=EXP(Y*ALOG(X)) / CPAGE 4 FFPER, 0614 / "FLPW" ERROR FROM LOC XXXXX 2027 FFPOW, BLOCK 2 / ENTRY POINT ML, CALL 1,SETERR ARG FFPER TAD I FFPOW / GET CDF TO EXPONENT DCA LXP INC FFPOW# / INCREMENT TO EXPONENT ADDRESS TAD I FFPOW / GET EXPONENT ADDRESS DCA LXP# INC FFPOW# / INCREMENT FOR EXIT TAD I LXP / HIGH ORDER WORD OF EXPONENT SNA CLA / IS IT ZERO JMP FFP5 / YES ... RESULT=1 TAD ACH / BASE IS IN FLOATING POINT AC SZA CLA / IF BASE EQUALS ZERO ... RESULT EQUALS ZERO JMP FFP1 CALL 0,CLRERR RETRN FFPOW / ZERO RESULT EXIT FFP1, CALL 1,STO / SAVE BASE FFP2, ARG X CALL 1,ALOG ARG X CALL 1,FMP / Y*LOG(X) LXP, ARG 0 / ADDRESS STORED HERE CALL 1,STO ARG X CALL 1,EXP ARG X FFP6, CALL 0,CLRERR RETRN FFPOW FFP5, CALL 0,CLEAR / ANYTHING TO ZERO POWER IS 1 CALL 1,FAD ARG ONE JMP FFP6 END