File: EXPIC.LS of Disk: V50/Source/Source-Listing-RALF-1
(Source file text)
RALF V50A 8-APR-92 PAGE 1
/C=R**C EXPIC INTEGER OR REAL RAISED TO COMPLEX INT. FUNC.
/
/
/ VERSION 50A 27-MAY-80 WVDM
/
/
/(A)^(C+I*D)
/A=0 YIELDS 0
/D=0 MEANS USE EXP3 TO CALCULATE A^C
/C+D=0 YIELDS 1.0
/ENTER + EXIT IN STARTE
/
SECT #EXPIC
DPCHK
EXTERN #CAC
EXTERN EXP
EXTERN COS
EXTERN SIN
EXTERN ALOG
EXTERN EXP3
EXTERN SQRT
/
BASE 0
00000 1030 EXPIC, JA .
00001 0000
00002 6400 FSTA C,0
00003 0275
00004 0005 STARTF
00005 0200 FLDA 0 /BASE
00006 6400 FSTA A,0
00007 0272
/
BASE .+2000 /DUMMY BASE
/
00010 0030 XTA 0
00011 6400 FSTA T1 /SAVE XR 0
00012 0330
00013 0400 FLDA A
00014 0272
00015 1040 JNE EX1 /A NOT 0
00016 0025
00017 0050 STARTE /A=B=0
00020 0002 FCLA
00021 6400 EX, FSTA #CAC /RESULT = 0
00022 0000
00023 1030 JA EXPIC
00024 0000
/
00025 0400 EX1, FLDA C /C+D=0?
00026 0275
00027 1040 JNE EX2
00030 0042
00031 0400 FLDA D
00032 0300
00033 1040 JNE EX2
00034 0042
RALF V50A 8-APR-92 PAGE 1-1
00035 0050 STARTE
00036 0400 FLDA FP1 /RESULT = 1 IF C=D=0
00037 0322
00040 1030 JA EX
00041 0021
/
00042 0400 EX2, FLDA D
00043 0300
00044 1040 JNE EX3 /USE EXP3 IF D=0
00045 0065
00046 1130 JSR EXP3
00047 0000
00050 1030 JA .+6
00051 0056
00052 1030 JA A
00053 0272
00054 1030 JA C
00055 0275
00056 6400 FSTA A
00057 0272
00060 0050 STARTE
00061 0400 FLDA A /RETURN AS REAL PART
00062 0272
00063 1030 JA EX
00064 0021
/
00065 0400 EX3, FLDA A /LOGR=ALOG(SQRT(A*A))
00066 0272
00067 4400 FMUL A
00070 0272
00071 6400 FSTA LOGR
00072 0303
00073 1130 JSR SQRT
00074 0000
00075 1030 JA .+4
00076 0101
00077 1030 JA LOGR
00100 0303
00101 6400 FSTA LOGR
00102 0303
00103 1130 JSR ALOG
00104 0000
00105 1030 JA .+4
00106 0111
00107 1030 JA LOGR
00110 0303
00111 6400 FSTA LOGR
00112 0303
00113 0400 FLDA D /ARG=C+D*LOGR
00114 0300
00115 4400 FMUL LOGR
00116 0303
00117 1400 FADD C
00120 0275
00121 6400 FSTA ARG
00122 0306
RALF V50A 8-APR-92 PAGE 1-2
/
00123 1130 JSR SIN /CALCULATE SIN AND COS OF ARG.
00124 0000
00125 1030 JA .+4 /SAVE SIGN OF EACH
00126 0131
00127 1030 JA ARG
00130 0306
00131 6400 FSTA SINE
00132 0311
00133 1130 JSR COS
00134 0000
00135 1030 JA .+4
00136 0141
00137 1030 JA ARG
00140 0306
00141 6400 FSTA CSINE
00142 0314
00143 0400 FLDA C /CALL C*LOGR-D
00144 0275
00145 4400 FMUL LOGR
00146 0303
00147 2400 FSUB D
00150 0300
00151 6400 FSTA REST
00152 0317
00153 0400 FLDA CSINE /REAL = EXP(REST+ALOG(CSINE))
00154 0314
00155 1050 JLT .+6
00156 0163
00157 0101 LDX 0,1 /=1 IF POSITIVE
00160 0000
00161 1030 JA .+3
00162 0164
00163 0003 FNEG
00164 1120 JSA DO
00165 0227
00166 2000 JXN .+3,0 /SKIP IF POS
00167 0171
00170 0003 FNEG
00171 6400 FSTA C
00172 0275
00173 0400 FLDA SINE /IMAG
00174 0311
00175 1050 JLT .+6
00176 0203
00177 0101 LDX 0,1
00200 0000
00201 1030 JA .+5
00202 0206
00203 0100 LDX 0,0
00204 0000
00205 0003 FNEG
00206 1120 JSA DO
00207 0227
00210 2000 JXN .+3,0
00211 0213
RALF V50A 8-APR-92 PAGE 1-3
00212 0003 FNEG /RESTORE SIGN
00213 6400 FSTA D
00214 0300
00215 0400 FLDA T1 /RESTORE XR0
00216 0330
00217 0020 ATX 0
00220 0050 STARTE
00221 0400 FLDA C
00222 0275
00223 6400 FSTA #CAC
00224 0000
00225 1030 JA EXPIC
00226 0000
/
00227 1030 DO, JA .
00230 0227
00231 6400 FSTA LOGR
00232 0303
00233 1130 JSR ALOG
00234 0000
00235 1030 JA .+4
00236 0241
00237 1030 JA LOGR
00240 0303
00241 1400 FADD REST
00242 0317
00243 6400 FSTA ARG
00244 0306
00245 1130 JSR EXP
00246 0000
00247 1030 JA .+4
00250 0253
00251 1030 JA ARG
00252 0306
00253 6400 FSTA ARG
00254 0306
00255 0400 FLDA LOGR /CHECK SIGN
00256 0303
00257 1010 JGE DOX
00260 0266
00261 0400 FLDA ARG
00262 0306
00263 0003 FNEG
00264 6400 FSTA ARG
00265 0306
00266 0400 DOX, FLDA ARG
00267 0306
00270 1030 JA DO
00271 0227
00272 0000 A, F 0.0
00273 0000
00274 0000
00275 0000 C, F 0.0
00276 0000
00277 0000
00300 0000 D, F 0.0
RALF V50A 8-APR-92 PAGE 1-4
00301 0000
00302 0000
00303 0000 LOGR, F 0.0
00304 0000
00305 0000
00306 0000 ARG, F 0.0
00307 0000
00310 0000
00311 0000 SINE, F 0.0
00312 0000
00313 0000
00314 0000 CSINE, F 0.0
00315 0000
00316 0000
00317 0000 REST, F 0.0
00320 0000
00321 0000
00322 0001 FP1, F 1.0
00323 2000
00324 0000
00325 0000 F 0.0
00326 0000
00327 0000
00330 0000 T1, F 0.0
00331 0000
00332 0000
RALF V50A 8-APR-92 PAGE 2
RALF V50A 8-APR-92 PAGE 2-1
NO ERRORS
25 SYMBOLS, NO ABS REFS
# C 00000 #CAC X 00000 #EXPIC S 00333 #MAIN S 00000
A 00272 ALOG X 00000 ARG 00306 C 00275
COS X 00000 CSINE 00314 D 00300 DO 00227
DOX 00266 EX 00021 EXP X 00000 EXPIC 00000
EXP3 X 00000 EX1 00025 EX2 00042 EX3 00065
FP1 00322 LOGR 00303 REST 00317 SIN X 00000
SINE 00311 SQRT X 00000 T1 00330