Commit | Line | Data |
---|---|---|
84b5715c PH |
1 | SECT DROP\r |
2 | / SUBROUTINE DROP(OBJECT,WHERE)\r | |
3 | / C\r | |
4 | / C PLACE AN OBJECT AT A GIVEN LOC, PREFIXING IT ONTO THE ATLOC LIST.\r | |
5 | / C DECR HOLDNG IF THE OBJECT WAS BEING TOTED.\r | |
6 | / C\r | |
7 | / IMPLICIT INTEGER (A-Z)\r | |
8 | / COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG\r | |
9 | / DIMENSION ATLOC(150)\r | |
10 | / DIMENSION LINK(200)\r | |
11 | / DIMENSION PLACE(100)\r | |
12 | / DIMENSION FIXED(100)\r | |
13 | \r | |
14 | JA #ST\r | |
15 | #XR, ORG .+10\r | |
16 | TEXT +DROP +\r | |
17 | #RET, SETX #XR\r | |
18 | SETB #BASE\r | |
19 | JA .+3\r | |
20 | #BASE, ORG .+6\r | |
21 | OBJECT, ORG .+3\r | |
22 | WHERE, ORG .+3\r | |
23 | ONE, F 1.0\r | |
24 | HUND, F 100.0\r | |
84b5715c PH |
25 | ORG #BASE+30\r |
26 | FNOP\r | |
27 | JA #RET\r | |
28 | FNOP\r | |
29 | #GOBAK, 0;0\r | |
30 | #LBL=.\r | |
31 | COMMON PLACOM\r | |
32 | ATLOC, ORG .+702\r | |
33 | LINK, ORG .+1130\r | |
34 | PLACE, ORG .+454\r | |
35 | FIXED, ORG .+454\r | |
36 | HOLDNG, ORG .+3\r | |
37 | ORG #LBL\r | |
38 | #RTN, BASE #BASE\r | |
39 | JA #GOBAK\r | |
40 | #ST, STARTD\r | |
41 | 0210\r | |
42 | FSTA #GOBAK,0\r | |
43 | 0200\r | |
44 | SETX #XR\r | |
45 | SETB #BASE\r | |
46 | LDX 0,1\r | |
47 | FSTA #BASE\r | |
48 | FLDA% #BASE,1+\r | |
49 | FSTA OBJECT\r | |
50 | FLDA% #BASE,1+\r | |
51 | FSTA WHERE\r | |
52 | STARTF\r | |
53 | FLDA% WHERE /Pre-load index regs\r | |
54 | ATX 6\r | |
55 | FLDA% OBJECT\r | |
56 | ATX 7\r | |
57 | / IF(OBJECT.GT.100)GOTO 1\r | |
58 | FSUB HUND\r | |
59 | ATX 5 /Save object-100\r | |
60 | JGT #1\r | |
61 | / IF(PLACE(OBJECT).EQ.-1)HOLDNG=HOLDNG-1\r | |
62 | FLDA ONE\r | |
63 | FADD PLACE-3,7\r | |
64 | JNE #G1\r | |
81e70d48 PH |
65 | FLDA HOLDNG\r |
66 | FSUB ONE\r | |
67 | FSTA HOLDNG\r | |
84b5715c PH |
68 | / PLACE(OBJECT)=WHERE\r |
69 | #G1, FLDA% WHERE\r | |
70 | FSTA PLACE-3,7\r | |
71 | / GOTO 2\r | |
72 | JA #2\r | |
73 | \r | |
74 | / 1 FIXED(OBJECT-100)=WHERE\r | |
75 | #1, FLDA% WHERE\r | |
76 | FSTA FIXED-3,5\r | |
77 | \r | |
78 | / 2 IF(WHERE.LE.0)RETURN\r | |
79 | #2, JLE #RTN\r | |
80 | / LINK(OBJECT)=ATLOC(WHERE)\r | |
81 | #G2, FLDA ATLOC-3,6\r | |
82 | FSTA LINK-3,7\r | |
83 | / ATLOC(WHERE)=OBJECT\r | |
84 | XTA 7\r | |
85 | FSTA ATLOC-3,6\r | |
86 | / RETURN\r | |
87 | / END\r | |
88 | JA #RTN\r | |
89 | END\r |