File: EXPIC.RA of Tape: OS8/OS8-Latest/new-10
(Source file text)
/C=R**C EXPIC INTEGER OR REAL RAISED TO COMPLEX INT. FUNC. / / / VERSION 40A 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 EXPIC, JA . FSTA C,0 STARTF FLDA 0 /BASE FSTA A,0 / BASE .+2000 /DUMMY BASE / XTA 0 FSTA T1 /SAVE XR 0 FLDA A JNE EX1 /A NOT 0 STARTE /A=B=0 FCLA EX, FSTA #CAC /RESULT = 0 JA EXPIC / EX1, FLDA C /C+D=0? JNE EX2 FLDA D JNE EX2 STARTE FLDA FP1 /RESULT = 1 IF C=D=0 JA EX / EX2, FLDA D JNE EX3 /USE EXP3 IF D=0 JSR EXP3 JA .+6 JA A JA C FSTA A STARTE FLDA A /RETURN AS REAL PART JA EX / EX3, FLDA A /LOGR=ALOG(SQRT(A*A)) FMUL A FSTA LOGR JSR SQRT JA .+4 JA LOGR FSTA LOGR JSR ALOG JA .+4 JA LOGR FSTA LOGR FLDA D /ARG=C+D*LOGR FMUL LOGR FADD C FSTA ARG / JSR SIN /CALCULATE SIN AND COS OF ARG. JA .+4 /SAVE SIGN OF EACH JA ARG FSTA SINE JSR COS JA .+4 JA ARG FSTA CSINE FLDA C /CALL C*LOGR-D FMUL LOGR FSUB D FSTA REST FLDA CSINE /REAL = EXP(REST+ALOG(CSINE)) JLT .+6 LDX 0,1 /=1 IF POSITIVE JA .+3 FNEG JSA DO JXN .+3,0 /SKIP IF POS FNEG FSTA C FLDA SINE /IMAG JLT .+6 LDX 0,1 JA .+5 LDX 0,0 FNEG JSA DO JXN .+3,0 FNEG /RESTORE SIGN FSTA D FLDA T1 /RESTORE XR0 ATX 0 STARTE FLDA C FSTA #CAC JA EXPIC / DO, JA . FSTA LOGR JSR ALOG JA .+4 JA LOGR FADD REST FSTA ARG JSR EXP JA .+4 JA ARG FSTA ARG FLDA LOGR /CHECK SIGN JGE DOX FLDA ARG FNEG FSTA ARG DOX, FLDA ARG JA DO A, F 0.0 C, F 0.0 D, F 0.0 LOGR, F 0.0 ARG, F 0.0 SINE, F 0.0 CSINE, F 0.0 REST, F 0.0 FP1, F 1.0 F 0.0 T1, F 0.0