| 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 |