A large commit.

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

diff --git a/sw/os8/v3d/sources/fortran/dectapes/dectape2/dmod.ra b/sw/os8/v3d/sources/fortran/dectapes/dectape2/dmod.ra
new file mode 100644 (file)
index 0000000..4b40494
--- /dev/null
+++ b/sw/os8/v3d/sources/fortran/dectapes/dectape2/dmod.ra
@@ -0,0 +1,79 @@
+/
+/
+/
+/      D  M  O  D
+/      -  -  -  -
+/
+/SUBROUTINE    DMOD(X,Y)
+/
+/ VERSION 5A 4-27-77  PT
+/
+       SECT    DMOD
+       JA      #DMOD
+       DPCHK
+       TEXT    +DMOD  +
+AMODXR,        SETX    XRAMOD
+       SETB    BPAMOD
+STHREE,        0007                    /73
+       2217
+       7777
+       7777
+       7777
+       7777
+BPAMOD,        F 0.0
+       F 0.0
+XRAMOD,        0;1;73          /73 FOR ALIGNING ON 59
+XSTOR, F 0.0
+       F 0.0
+AMODX, F 0.0
+       F 0.0
+       ORG     10*3+BPAMOD
+       FNOP
+       JA      AMODXR
+       0
+AMDRTN,        JA      .
+       EXTERN  #ARGER
+AMODER,        TRAP4   #ARGER
+       FCLA
+       JA      AMDRTN
+       BASE    0
+#DMOD, STARTD
+       FLDA    10*3
+       FSTA    AMDRTN
+       FLDA    0
+       SETX    XRAMOD
+       SETB    BPAMOD
+       BASE    BPAMOD
+       FSTA    BPAMOD
+       LDX     1,1
+       FLDA%   BPAMOD,1   /ADDR OF X
+       FSTA    AMODX
+       FLDA%   BPAMOD,1+  /ADDR OF Y
+       FSTA    BPAMOD
+       STARTE
+       FLDA%   BPAMOD          /GET Y
+       JEQ     AMODER          /Y=0 IS ERROR
+       FLDA%   BPAMOD
+       JGT     .+3             /GET ABS VALUE
+       FNEG
+       FSTA    BPAMOD
+       FLDA%   AMODX           /GET X
+       JGT     .+5
+       FNEG            /GET ABS VALUE OF X
+       LDX     0,1             /NOTE THE SIGN
+       FSTA    AMODX   /SAV IN A TEMPORARY
+       FDIV    BPAMOD  /DIVIDE BY Y
+       FSTA    XSTOR           /SAVE X/Y
+       XTA     3               /GET EXPONENT
+       FSUB    STHREE          /CHECK SIZE
+       JGE     AMODER          /TOO BIG
+       FLDA    XSTOR           /ABS VALUE X/Y
+       ALN     2               /FIX IT UP NOW.
+       FNORM
+       FMUL    BPAMOD          /MULITPLY IT.
+       FNEG                    /NEGATE IT.
+       FADD    AMODX           /AND ADD IN X.
+       JXN     AMR,1
+       FNEG            /RESTORE SIGN
+AMR,   JA      AMDRTN
+\f