software: Added more and more

[pdp8.git] / sw / os8 / v3d / sources / system / dectapes / dectape3 / IPOWRS.SB

diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/IPOWRS.SB b/sw/os8/v3d/sources/system/dectapes/dectape3/IPOWRS.SB
new file mode 100644 (file)
index 0000000..af382a3
--- /dev/null
+++ b/sw/os8/v3d/sources/system/dectapes/dectape3/IPOWRS.SB
@@ -0,0 +1,163 @@
+/INTEGER POWERS OF NUMBERS               ...INTEGER AND FLOATING POINT
+/
+/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 2A
+/      VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
+
+       ENTRY   IIPOW
+       ENTRY   FIPOW
+       OPDEF   TADI    1400
+
+       LAP
+
+FIPOW, BLOCK   1
+       2
+       TAD     FIPOW
+       DCA     IIPOW
+       TAD     FIPOW#
+       DCA     IIPOW#
+       CALL    1,STO
+       ARG     X       /SAVE BASE
+       JMP     FIFI
+
+X,     BLOCK 3
+RSLT,  BLOCK 3
+N,     0
+FISW,  0
+IIPOW, BLOCK   1
+       2
+       DCA     X       /SAVE BASE
+       IAC
+FIFI,  DCA     FISW
+       TAD     IIPOW
+       DCA     II
+II,    NOP
+       TADI    IIPOW#
+       DCA     NCDF
+       INC     IIPOW#
+       TADI    IIPOW#
+       DCA     N
+       INC     IIPOW#
+NCDF,  NOP             /GET FIELD OF EXPONENT
+       TADI    N       /GET EXPONENT
+       CLL
+       SPA
+       CIA CML
+       DCA     N       /SAVE ABS VALUE
+       TAD     X
+/*********    THE FOLLOWING CODE MAY BE REPLACED BY JUST "SNA CLA"
+/*********    IF THE RULES ARE THAT 0**ANYTHING=0 FOR FLOATING
+/*********    POINT TOO.  (REMEMBER 0**0 AND 0**-1!)
+       SNA CLA
+       TAD     FISW
+       SZA CLA
+/*********
+       JMP     IPRTRN  /BASE=0 MEANS RESULT=0
+       TAD     FISW
+       SZA
+       JMP     DCARSL
+ACHONE,        TAD     (2014
+       DCA     ACH     /INITIALIZE FPAC TO 1.0
+DCARSL,        DCA     RSLT    /INITIALIZE RSLT TO FISW
+       SNL             /THE LINK SHOULD CONTAIN THE EXPONENT SIGN
+       JMP     BACK    /POSITIVE - ALLS WELL
+       TAD     FISW
+       SZA CLA
+       JMP     IPRTRN  /I**-N = 0
+       CALL    1,FDV
+       ARG     X       /THERE'S A 1.0 IN THE AC, REMEMBER?
+       CALL    1,STO
+       ARG     X
+       CLL             /FAKE A POSITIVE SIGN
+       JMP     ACHONE  /GO BACK AND RESTORE FPAC TO 1.0
+
+BACK,  TAD     N       /USE STANDARD POWER-OF-2 ALGORITHM FOR POWERS
+       SNA
+       JMP     DONE
+       CLL RAR
+       DCA     N
+       SNL
+       JMP     LOOP
+       TAD     RSLT
+       SNA
+       JMP     FPMULT  /RSLT=0 MEANS FLOATING POINT
+       CALL    1,MPY
+       ARG     X
+STRSLT,        DCA     RSLT
+LOOP,  TAD     N
+       SNA CLA
+       JMP     DONE
+       TAD     FISW
+       SNA CLA
+       JMP     FPSQR
+       TAD     X
+       CALL    1,MPY
+       ARG     X
+       DCA     X
+       JMP     BACK
+
+FPMULT,        CALL    1,FMP   /DO THE SAME STUFF IN FLOATING POINT
+       ARG     X       /THAT WE DID ABOVE IN INTEGERS
+       JMP     STRSLT
+
+FPSQR, CALL    1,STO
+       ARG     RSLT    /SAVE FLTG AC
+       CALL    1,FAD
+       ARG     X
+       CALL    1,FMP
+       ARG     X
+       CALL    1,STO
+       ARG     X       /SQUARE X
+       CALL    1,FAD
+       ARG     RSLT
+       DCA     RSLT    /KEEP RSLT ZERO!
+       JMP     BACK
+
+DONE,  TAD     RSLT
+IPRTRN,        RETRN   IIPOW
+
+
+       END
+\f