X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Fos8%2Fv3d%2Fsources%2Fsystem%2Fdectapes%2Fdectape3%2FPOWERS.SB;fp=sw%2Fos8%2Fv3d%2Fsources%2Fsystem%2Fdectapes%2Fdectape3%2FPOWERS.SB;h=99a9981f7f121a3b302a016c9656e0c396cdf556;hb=7af5ad59491ddf2066641aef1e0025a337c0f247;hp=0000000000000000000000000000000000000000;hpb=919757fd611e482003ce51f366f6783cab73dea3;p=pdp8.git diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/POWERS.SB b/sw/os8/v3d/sources/system/dectapes/dectape3/POWERS.SB new file mode 100644 index 0000000..99a9981 --- /dev/null +++ b/sw/os8/v3d/sources/system/dectapes/dectape3/POWERS.SB @@ -0,0 +1,319 @@ +/POWERS SUBROUTINE OS8 FORTRAN II LIBRARY +/ +/ +/ +/ +/ +/ +/ +/ +/ +/COPYRIGHT (C) 1974,1977 BY DIGITAL EQUIPMENT CORPORATION +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ +/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE +/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT +/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY +/FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL. +/ +/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER +/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED +/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH +/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. +/ +/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE +/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY +/DIGITAL. +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ + / VERSION 5A +/ VERSION NUMBER IS AVAILABLE AT ENTRY POINTS + ENTRY IFPOW / INTEGER TO FLOATING POWER + ENTRY FFPOW / FLOATING TO FLOATING POWER + ENTRY EXP / E TO A POWER + ENTRY ALOG / NATURAL LOGARITHM +/ +/ + DUMMY LXP + OPDEF JMSKP 4000 +/ +/ 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 + +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 + 1707 +ALOG, BLOCK 1 + 5 / ENTRY POINT + TAD ALOG + DCA TEM + TAD ALOG# + DCA TEM# + CALL 1,IFAD +TEM, ARG 0 + INC ALOG# + INC ALOG# + TAD ACH / GET EXPONENT + SPA SNA + JMP LGERR /LOG OF X<=0 - ERROR + 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 + RETRN ALOG / EXIT +LGERR, CALL 1,ERROR + ARG LGER + +/ +/ 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, 4530 + 2040 +EXP, BLOCK 1 + 5 / ENTRY POINT + TAD EXP + DCA XT + TAD EXP# + DCA XT# + INC EXP# + INC EXP# + CALL 1,IFAD +XT, ARG 0 + CLA CLL CMA RAR + AND ACH + TAD (-2075 + SMA CLA + TAD ACM + CLL + TAD (-4271 /TEST FOR FLTG. AC <88.2 + SZL CLA + JMP EXPERR + 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 + RETRN EXP / EXIT +EXPERR, CALL 1,ERROR + ARG EXPER + TAD ACH + SMA CLA + CLL CMA RAR + DCA ACH + DCA ACM + DCA ACL + RETRN EXP + +/ +/ IFPOW - INTEGER TO FLOATING POWER +/ +/ JUST FLOAT BASE AND GO TO FFPOW +/ +IFPOW, BLOCK 1 + 5 / 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 + +/ +/ FFPOW- FLOATING TO FLOATING POWER +/ +/ IDENTITY USED ... X**Y=EXP(Y*ALOG(X)) +/ + CPAGE 4 +FFPER, 4614 + 2027 +FFPOW, BLOCK 1 + 5 / ENTRY POINT +ML, 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 + SPA + JMP FFPERR + SZA CLA / IF BASE EQUALS ZERO ... RESULT EQUALS ZERO + JMP FFP1 + 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, RETRN FFPOW +FFP5, CALL 0,CLEAR / ANYTHING TO ZERO POWER IS 1 + TAD (2014 + DCA ACH + JMP FFP6 +FFPERR, TAD (4000 + DCA ACH + CALL 1,ERROR + ARG FFPER + JMP FFP1 + END +