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