Add README.md
[pdp8.git] / sw / f4 / FRTSRC / 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