A large commit.
[pdp8.git] / sw / os8 / v3d / sources / fortran / all / carith.ra
diff --git a/sw/os8/v3d/sources/fortran/all/carith.ra b/sw/os8/v3d/sources/fortran/all/carith.ra
new file mode 100644 (file)
index 0000000..e2770c3
--- /dev/null
@@ -0,0 +1,110 @@
+/COMPLEX ARITHMETIC ROUTINES
+/ (A+BI)+-*/(C+DI)
+/
+/ VERSION 5A 4-26-77 MH
+/
+       DPCHK
+       SECT    #CAD
+       JA      .
+       FSTA    #CARG           /SAVE SECOND ARG
+       STARTF
+       FLDA    #CARG           /STARTF ROUNDS
+       FADDM   #CAC            /A+C
+       FLDA    #CARG+3
+       FADDM   #CAC+3          /B+D
+       STARTE
+       JA      #CAD
+       ENTRY   #CSB
+#CSB,  JA      .
+       FSTA    #CARG
+       STARTF
+       FLDA    #CARG           /STARTF ROUNDS
+       FNEG
+       FADDM   #CAC            /A-C
+       FLDA    #CAC+3
+       FSUB    #CARG+3         /B-D
+       FSTA    #CAC+3
+       STARTE
+       JA      #CSB
+       ENTRY   #CNG
+#CNG,  JA      .
+       STARTF
+       FLDA    #CAC
+       FNEG
+       FSTA    #CAC
+       FLDA    #CAC+3
+       FNEG
+       FSTA    #CAC+3
+       STARTE
+       JA      #CNG
+       ENTRY   #CEQ
+#CEQ,  JA      .
+       JSA     #CSB
+       STARTF
+       FLDA    #CAC
+       JNE     NOTEQ
+       FLDA    #CAC+3
+       JNE     NOTEQ
+       FLDA    ONE
+       JA      #CEQ
+NOTEQ, FCLA
+       JA      #CEQ
+ONE,   F       1.0
+       ENTRY   #CML
+#CML,  JA      .
+       FSTA    #CARG
+       STARTF
+       FLDA    #CARG           /STARTF ROUNDS
+       FMUL    #CAC            /A*C
+       FSTA    TEMP
+       FLDA    #CARG+3
+       FMUL    #CAC+3          /B*D
+       FSTA    TEMP2
+       FLDA    #CARG
+       FMULM   #CAC+3          /B*C
+       FLDA    #CAC
+       FMUL    #CARG+3         /A*D
+       FADDM   #CAC+3          /A*D+B*C
+       FLDA    TEMP
+       FSUB    TEMP2           /A*C-B*D
+       FSTA    #CAC
+       STARTE
+       JA      #CML
+       ENTRY   #CDV
+#CDV,  JA      .
+       FSTA    #CARG
+       STARTF
+       FLDA    #CARG           /STARTF ROUNDS
+       FMUL    #CAC+3          /B*C
+       FSTA    TEMP
+       FLDA    #CARG+3
+       FMUL    #CAC            /A*D
+       FSTA    TEMP2
+       FLDA    #CARG
+       FMULM   #CAC            /A*C
+       FLDA    #CAC+3
+       FMUL    #CARG+3         /B*D
+       FADDM   #CAC            /A*C+B*D
+       FLDA    #CARG
+       FMULM   #CARG           /C*C
+       FLDA    #CARG+3
+       FMUL    #CARG+3         /D*D
+       FADDM   #CARG           /C*C+D*D
+       FLDA    TEMP
+       FSUB    TEMP2           /B*C-A*D
+       FDIV    #CARG           /(B*C-A*D)/(C*C+D*D)
+       FSTA    #CAC+3
+       FLDA    #CAC
+       FDIV    #CARG           /(A*C+B*D)/(C*C+D*D)
+       FSTA    #CAC
+       STARTE
+       JA      #CDV
+TEMP,  0;0;0
+TEMP2, 0;0;0
+#CARG, 0;0;0
+       0;0;0
+       ENTRY   #CAC
+#CAC,  0;0;0
+       0;0;0
+       END
+\f