sw/os8/v3d/sources/fortran/dectapes/dectape2/dmod.ra

   1 /
   2 /
   3 /
   4 /       D  M  O  D
   5 /       -  -  -  -
   6 /
   7 /SUBROUTINE     DMOD(X,Y)
   8 /
   9 / VERSION 5A 4-27-77  PT
  10 /
  11         SECT    DMOD
  12         JA      #DMOD
  13         DPCHK
  14         TEXT    +DMOD  +
  15 AMODXR, SETX    XRAMOD
  16         SETB    BPAMOD
  17 STHREE, 0007                    /73
  18         2217
  19         7777
  20         7777
  21         7777
  22         7777
  23 BPAMOD, F 0.0
  24         F 0.0
  25 XRAMOD, 0;1;73          /73 FOR ALIGNING ON 59
  26 XSTOR,  F 0.0
  27         F 0.0
  28 AMODX,  F 0.0
  29         F 0.0
  30         ORG     10*3+BPAMOD
  31         FNOP
  32         JA      AMODXR
  33         0
  34 AMDRTN, JA      .
  35         EXTERN  #ARGER
  36 AMODER, TRAP4   #ARGER
  37         FCLA
  38         JA      AMDRTN
  39         BASE    0
  40 #DMOD,  STARTD
  41         FLDA    10*3
  42         FSTA    AMDRTN
  43         FLDA    0
  44         SETX    XRAMOD
  45         SETB    BPAMOD
  46         BASE    BPAMOD
  47         FSTA    BPAMOD
  48         LDX     1,1
  49         FLDA%   BPAMOD,1   /ADDR OF X
  50         FSTA    AMODX
  51         FLDA%   BPAMOD,1+  /ADDR OF Y
  52         FSTA    BPAMOD
  53         STARTE
  54         FLDA%   BPAMOD          /GET Y
  55         JEQ     AMODER          /Y=0 IS ERROR
  56         FLDA%   BPAMOD
  57         JGT     .+3             /GET ABS VALUE
  58         FNEG
  59         FSTA    BPAMOD
  60         FLDA%   AMODX           /GET X
  61         JGT     .+5
  62         FNEG            /GET ABS VALUE OF X
  63         LDX     0,1             /NOTE THE SIGN
  64         FSTA    AMODX   /SAV IN A TEMPORARY
  65         FDIV    BPAMOD  /DIVIDE BY Y
  66         FSTA    XSTOR           /SAVE X/Y
  67         XTA     3               /GET EXPONENT
  68         FSUB    STHREE          /CHECK SIZE
  69         JGE     AMODER          /TOO BIG
  70         FLDA    XSTOR           /ABS VALUE X/Y
  71         ALN     2               /FIX IT UP NOW.
  72         FNORM
  73         FMUL    BPAMOD          /MULITPLY IT.
  74         FNEG                    /NEGATE IT.
  75         FADD    AMODX           /AND ADD IN X.
  76         JXN     AMR,1
  77         FNEG            /RESTORE SIGN
  78 AMR,    JA      AMDRTN
  79 \f