--- /dev/null
+/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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/ 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
+\f
+/
+/ 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
+\f
+/
+/ 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
+\f
+/
+/ 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
+\f
projects / pdp8.git / blobdiff