sw/os8/v3d/sources/system/dectapes/dectape3/IPOWRS.SB

   1 /INTEGER POWERS OF NUMBERS               ...INTEGER AND FLOATING POINT
   2 /
   3 /OS8 FORTRAN II LIBRARY
   4 /
   5 /
   6 /
   7 /
   8 /
   9 /
  10 /
  11 /
  12 /COPYRIGHT  (C)  1974,1977 BY DIGITAL EQUIPMENT CORPORATION
  13 /
  14 /
  15 /
  16 /
  17 /
  18 /
  19 /
  20 /
  21 /
  22 /
  23 /THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
  24 /AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
  25 /CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
  26 /FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL.
  27 /
  28 /THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
  29 /UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
  30 /(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
  31 /SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
  32 /
  33 /DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
  34 /OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
  35 /DIGITAL.
  36 /
  37 /
  38 /
  39 /
  40 /
  41 /
  42 /
  43 /
  44 /
  45 /
  46 \f/      VERSION 2A
  47 /       VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
  48
  49         ENTRY   IIPOW
  50         ENTRY   FIPOW
  51         OPDEF   TADI    1400
  52
  53         LAP
  54
  55 FIPOW,  BLOCK   1
  56         2
  57         TAD     FIPOW
  58         DCA     IIPOW
  59         TAD     FIPOW#
  60         DCA     IIPOW#
  61         CALL    1,STO
  62         ARG     X       /SAVE BASE
  63         JMP     FIFI
  64
  65 X,      BLOCK 3
  66 RSLT,   BLOCK 3
  67 N,      0
  68 FISW,   0
  69 IIPOW,  BLOCK   1
  70         2
  71         DCA     X       /SAVE BASE
  72         IAC
  73 FIFI,   DCA     FISW
  74         TAD     IIPOW
  75         DCA     II
  76 II,     NOP
  77         TADI    IIPOW#
  78         DCA     NCDF
  79         INC     IIPOW#
  80         TADI    IIPOW#
  81         DCA     N
  82         INC     IIPOW#
  83 NCDF,   NOP             /GET FIELD OF EXPONENT
  84         TADI    N       /GET EXPONENT
  85         CLL
  86         SPA
  87         CIA CML
  88         DCA     N       /SAVE ABS VALUE
  89         TAD     X
  90 /*********    THE FOLLOWING CODE MAY BE REPLACED BY JUST "SNA CLA"
  91 /*********    IF THE RULES ARE THAT 0**ANYTHING=0 FOR FLOATING
  92 /*********    POINT TOO.  (REMEMBER 0**0 AND 0**-1!)
  93         SNA CLA
  94         TAD     FISW
  95         SZA CLA
  96 /*********
  97         JMP     IPRTRN  /BASE=0 MEANS RESULT=0
  98         TAD     FISW
  99         SZA
 100         JMP     DCARSL
 101 ACHONE, TAD     (2014
 102         DCA     ACH     /INITIALIZE FPAC TO 1.0
 103 DCARSL, DCA     RSLT    /INITIALIZE RSLT TO FISW
 104         SNL             /THE LINK SHOULD CONTAIN THE EXPONENT SIGN
 105         JMP     BACK    /POSITIVE - ALLS WELL
 106         TAD     FISW
 107         SZA CLA
 108         JMP     IPRTRN  /I**-N = 0
 109         CALL    1,FDV
 110         ARG     X       /THERE'S A 1.0 IN THE AC, REMEMBER?
 111         CALL    1,STO
 112         ARG     X
 113         CLL             /FAKE A POSITIVE SIGN
 114         JMP     ACHONE  /GO BACK AND RESTORE FPAC TO 1.0
 115
 116 BACK,   TAD     N       /USE STANDARD POWER-OF-2 ALGORITHM FOR POWERS
 117         SNA
 118         JMP     DONE
 119         CLL RAR
 120         DCA     N
 121         SNL
 122         JMP     LOOP
 123         TAD     RSLT
 124         SNA
 125         JMP     FPMULT  /RSLT=0 MEANS FLOATING POINT
 126         CALL    1,MPY
 127         ARG     X
 128 STRSLT, DCA     RSLT
 129 LOOP,   TAD     N
 130         SNA CLA
 131         JMP     DONE
 132         TAD     FISW
 133         SNA CLA
 134         JMP     FPSQR
 135         TAD     X
 136         CALL    1,MPY
 137         ARG     X
 138         DCA     X
 139         JMP     BACK
 140
 141 FPMULT, CALL    1,FMP   /DO THE SAME STUFF IN FLOATING POINT
 142         ARG     X       /THAT WE DID ABOVE IN INTEGERS
 143         JMP     STRSLT
 144
 145 FPSQR,  CALL    1,STO
 146         ARG     RSLT    /SAVE FLTG AC
 147         CALL    1,FAD
 148         ARG     X
 149         CALL    1,FMP
 150         ARG     X
 151         CALL    1,STO
 152         ARG     X       /SQUARE X
 153         CALL    1,FAD
 154         ARG     RSLT
 155         DCA     RSLT    /KEEP RSLT ZERO!
 156         JMP     BACK
 157
 158 DONE,   TAD     RSLT
 159 IPRTRN, RETRN   IIPOW
 160
 161
 162         END
 163 \f