A large commit.

[pdp8.git] / sw / os8 / v3d / sources / fortran / dectapes / dectape2 / expic.ra

diff --git a/sw/os8/v3d/sources/fortran/dectapes/dectape2/expic.ra b/sw/os8/v3d/sources/fortran/dectapes/dectape2/expic.ra
new file mode 100644 (file)
index 0000000..7c2d22c
--- /dev/null
+++ b/sw/os8/v3d/sources/fortran/dectapes/dectape2/expic.ra
@@ -0,0 +1,142 @@
+/
+/EXPIC
+/INTEGER OR REAL RAISED TO COMPLEX
+/
+/ VERSION 5A 4-26-77 MH
+/
+/(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
+       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
+/
+/LOGR=ALOG(SQRT(A*A))
+EX3,   FLDA    A
+       FMUL    A
+       FSTA    LOGR
+       JSR     SQRT
+       JA      .+4
+       JA      LOGR
+       FSTA    LOGR
+       JSR     ALOG
+       JA      .+4
+       JA      LOGR
+       FSTA    LOGR
+/ARG=C+D*LOGR
+       FLDA    D
+       FMUL    LOGR
+       FADD    C
+       FSTA    ARG
+/
+/CALCULATE SIN AND COS OF ARG. SAVE SIGN OF EACH
+       JSR     SIN
+       JA      .+4
+       JA      ARG
+       FSTA    SINE
+       JSR     COS
+       JA      .+4
+       JA      ARG
+       FSTA    CSINE
+/CALL C*LOGR-D
+       FLDA    C
+       FMUL    LOGR
+       FSUB    D
+       FSTA    REST
+/REAL = EXP(REST+ALOG(CSINE))
+       FLDA    CSINE   /REAL
+       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
+\f