A large commit.

[pdp8.git] / sw / os8 / v3d / sources / fortran / all / expcc.ra

diff --git a/sw/os8/v3d/sources/fortran/all/expcc.ra b/sw/os8/v3d/sources/fortran/all/expcc.ra
new file mode 100644 (file)
index 0000000..691dc0c
--- /dev/null
+++ b/sw/os8/v3d/sources/fortran/all/expcc.ra
@@ -0,0 +1,165 @@
+/
+/EXPCC
+/COMPLEX RAISED TO COMPLEX
+/
+/ VERSION 5A 4-26-77 MH
+/
+/(A+I*B)^(C+I*D)
+/A+B=0 YIELDS 0
+/B+D=0 MEANS USE EXP3 TO CALCULATTE A^C
+/A+B=0,C+D=0 YIELDS 1.0
+/ENTER + EXIT IN STARTE
+       SECT    #EXPCC
+       DPCHK
+       EXTERN  #CAC
+       EXTERN  EXP
+       EXTERN  COS
+       EXTERN  SIN
+       EXTERN  ALOG
+       EXTERN  EXP3
+       EXTERN  ATAN2
+       EXTERN  SQRT
+       BASE    0
+EXPCC, JA      .
+       FSTA    C,0
+       FLDA    0
+       FSTA    A,0
+       STARTF
+       BASE    .+2000
+       XTA     0
+       FSTA    T1              /SAVE XR 0
+       FLDA    A
+       JNE     EX1     /A NOT 0
+       FLDA    B
+       JNE     EX1
+       STARTE          /A=B=0
+       FCLA
+EX,    FSTA    #CAC            /RESULT = 0
+       JA      EXPCC
+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    B
+       JNE     EX3             /USE EXP3 IF B=D=0
+       FLDA     D
+       JNE     EX3
+       STARTF
+       JSR     EXP3
+       JA      .+6
+       JA      A
+       JA      C
+       FSTA    A
+       STARTE
+       FLDA    A               /RETURN AS REAL PART
+       JA      EX
+EX3,   STARTF
+/TH=ATAN(B/A)
+       JSR     ATAN2
+       JA      .+6
+       JA      B
+       JA      A
+       FSTA    TH
+/
+/LOGR=ALOG(SQRT(A*A+B*B))
+       FLDA    A
+       FMUL    A
+       FSTA    LOGR
+       FLDA    B
+       FMUL    B
+       FADDM   LOGR
+       JSR     SQRT
+       JA      .+4
+       JA      LOGR
+       FSTA    LOGR
+       JSR     ALOG
+       JA      .+4
+       JA      LOGR
+       FSTA    LOGR
+/ARG=C*TH+D*LOGR
+       FLDA    C
+       FMUL    TH
+       FSTA    ARG
+       FLDA    D
+       FMUL    LOGR
+       FADDM   ARG
+/
+/CALCULATE IN 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*TH
+       FLDA    D
+       FMUL    TH
+       FSTA    REST
+       FLDA    C
+       FMUL    LOGR
+       FSUB    REST
+       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    A
+       FLDA    SINE            /IMAG
+       JLT     .+6
+       LDX     0,1
+       JA      .+5
+       LDX     0,0
+       FNEG
+       JSA     DO
+       JXN     .+3,0
+       FNEG                    /RESTORE SIGN
+       FSTA    B
+       FLDA    T1              /RESTORE XR0
+       ATX     0
+       STARTE
+       FLDA    A
+       FSTA    #CAC
+       JA      EXPCC
+/
+DO,    JA      .
+       FSTA    TH
+       JSR     ALOG
+       JA      .+4
+       JA      TH
+       FADD    REST
+       FSTA    ARG
+       JSR     EXP
+       JA      .+4
+       JA      ARG
+       FSTA    ARG
+       FLDA    TH              /CHECK SIGN
+       JGE     DOX
+       FLDA    ARG
+       FNEG
+       FSTA    ARG
+DOX,   FLDA    ARG
+       JA      DO
+A,     F 0.0
+B,     F 0.0
+C,     F 0.0
+D,     F 0.0
+LOGR,  F 0.0
+TH,    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