Commit | Line | Data |
---|---|---|
84b5715c PH |
1 | SECT CARRY\r |
2 | / SUBROUTINE CARRY(OBJECT,WHERE)\r | |
3 | / C\r | |
4 | / C START TOTING AN OBJECT, REMOVING IT FROM THE LIST OF THINGS AT ITS FORMER\r | |
5 | / C LOCATION. INCR HOLDNG UNLESS IT WAS ALREADY BEING TOTED. IF OBJECT>100\r | |
6 | / C (MOVING "FIXED" SECOND LOC), DON'T CHANGE PLACE OR HOLDNG.\r | |
7 | / C\r | |
8 | / IMPLICIT INTEGER (A-Z)\r | |
9 | / COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG\r | |
10 | / DIMENSION ATLOC(150),LINK(200),PLACE(100),FIXED(100)\r | |
11 | / C\r | |
12 | \r | |
13 | JA #ST\r | |
14 | #XR, ORG .+10\r | |
15 | TEXT +CARRY+\r | |
16 | #RET, SETX #XR\r | |
17 | SETB #BASE\r | |
18 | JA .+3\r | |
19 | #BASE, ORG .+6\r | |
20 | OBJECT, ORG .+3\r | |
21 | WHERE, ORG .+3\r | |
22 | HUND, F 100.0\r | |
23 | ONE, F 1.0\r | |
24 | M1, F -1.0\r | |
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 .+0702\r | |
33 | LINK, ORG .+1130\r | |
34 | PLACE, ORG .+0454\r | |
35 | FIXED, ORG .+0454\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 indexes\r | |
54 | ATX 6\r | |
55 | FLDA% OBJECT\r | |
56 | ATX 7 /Fall thru with OBJECT in AC\r | |
57 | / IF(OBJECT.GT.100)GOTO 5\r | |
58 | FSUB HUND\r | |
59 | JGT #5\r | |
60 | / IF(PLACE(OBJECT).EQ.-1)RETURN\r | |
61 | FLDA ONE\r | |
62 | FADD PLACE-3,7\r | |
63 | JEQ #RTN\r | |
64 | / PLACE(OBJECT)=-1\r | |
65 | FLDA M1\r | |
66 | FSTA PLACE-3,7\r | |
67 | / HOLDNG=HOLDNG+1\r | |
68 | FLDA ONE\r | |
69 | FADDM HOLDNG\r | |
70 | \r | |
71 | / 5 IF(ATLOC(WHERE).NE.OBJECT)GOTO 6\r | |
72 | #5, FLDA ATLOC-3,6\r | |
73 | FSUB% OBJECT\r | |
74 | JNE #6\r | |
75 | / ATLOC(WHERE)=LINK(OBJECT)\r | |
76 | FLDA LINK-3,7\r | |
77 | FSTA ATLOC-3,6\r | |
78 | / RETURN\r | |
79 | JA #RTN\r | |
80 | \r | |
81 | / 6 TEMP=ATLOC(WHERE)\r | |
82 | #6, FLDA ATLOC-3,6\r | |
83 | / 7 IF(LINK(TEMP).EQ.OBJECT)GOTO 8\r | |
84 | #7, ATX 5\r | |
85 | FLDA LINK-3,5\r | |
86 | FSUB% OBJECT\r | |
87 | JEQ #8\r | |
88 | / TEMP=LINK(TEMP)\r | |
89 | FLDA LINK-3,5\r | |
90 | / GOTO 7\r | |
91 | JA #7\r | |
92 | \r | |
93 | / 8 LINK(TEMP)=LINK(OBJECT)\r | |
94 | #8, FLDA LINK-3,7\r | |
95 | FSTA LINK-3,5\r | |
96 | / RETURN\r | |
97 | / END\r | |
98 | JA #RTN\r | |
99 | END\r |