--- /dev/null
+ SECT CARRY\r
+/ SUBROUTINE CARRY(OBJECT,WHERE)\r
+/ C\r
+/ C START TOTING AN OBJECT, REMOVING IT FROM THE LIST OF THINGS AT ITS FORMER\r
+/ C LOCATION. INCR HOLDNG UNLESS IT WAS ALREADY BEING TOTED. IF OBJECT>100\r
+/ C (MOVING "FIXED" SECOND LOC), DON'T CHANGE PLACE OR HOLDNG.\r
+/ C\r
+/ IMPLICIT INTEGER (A-Z)\r
+/ COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG\r
+/ DIMENSION ATLOC(150),LINK(200),PLACE(100),FIXED(100)\r
+/ C\r
+\r
+ JA #ST\r
+#XR, ORG .+10\r
+ TEXT +CARRY+\r
+#RET, SETX #XR\r
+ SETB #BASE\r
+ JA .+3\r
+#BASE, ORG .+6\r
+OBJECT, ORG .+3\r
+WHERE, ORG .+3\r
+HUND, F 100.0\r
+ONE, F 1.0\r
+M1, F -1.0\r
+ ORG #BASE+30\r
+ FNOP\r
+ JA #RET\r
+ FNOP\r
+#GOBAK, 0;0\r
+ #LBL=.\r
+ COMMON PLACOM\r
+ATLOC, ORG .+0702\r
+LINK, ORG .+1130\r
+PLACE, ORG .+0454\r
+FIXED, ORG .+0454\r
+HOLDNG, ORG .+3\r
+ ORG #LBL\r
+#RTN, BASE #BASE\r
+ JA #GOBAK\r
+#ST, STARTD\r
+ 0210\r
+ FSTA #GOBAK,0\r
+ 0200\r
+ SETX #XR\r
+ SETB #BASE\r
+ LDX 0,1\r
+ FSTA #BASE\r
+ FLDA% #BASE,1+\r
+ FSTA OBJECT\r
+ FLDA% #BASE,1+\r
+ FSTA WHERE\r
+ STARTF\r
+ FLDA% WHERE /Pre-load indexes\r
+ ATX 6\r
+ FLDA% OBJECT\r
+ ATX 7 /Fall thru with OBJECT in AC\r
+/ IF(OBJECT.GT.100)GOTO 5\r
+ FSUB HUND\r
+ JGT #5\r
+/ IF(PLACE(OBJECT).EQ.-1)RETURN\r
+ FLDA ONE\r
+ FADD PLACE-3,7\r
+ JEQ #RTN\r
+/ PLACE(OBJECT)=-1\r
+ FLDA M1\r
+ FSTA PLACE-3,7\r
+/ HOLDNG=HOLDNG+1\r
+ FLDA ONE\r
+ FADDM HOLDNG\r
+\r
+/ 5 IF(ATLOC(WHERE).NE.OBJECT)GOTO 6\r
+#5, FLDA ATLOC-3,6\r
+ FSUB% OBJECT\r
+ JNE #6\r
+/ ATLOC(WHERE)=LINK(OBJECT)\r
+ FLDA LINK-3,7\r
+ FSTA ATLOC-3,6\r
+/ RETURN\r
+ JA #RTN\r
+\r
+/ 6 TEMP=ATLOC(WHERE)\r
+#6, FLDA ATLOC-3,6\r
+/ 7 IF(LINK(TEMP).EQ.OBJECT)GOTO 8\r
+#7, ATX 5\r
+ FLDA LINK-3,5\r
+ FSUB% OBJECT\r
+ JEQ #8\r
+/ TEMP=LINK(TEMP)\r
+ FLDA LINK-3,5\r
+/ GOTO 7\r
+ JA #7\r
+\r
+/ 8 LINK(TEMP)=LINK(OBJECT)\r
+#8, FLDA LINK-3,7\r
+ FSTA LINK-3,5\r
+/ RETURN\r
+/ END\r
+ JA #RTN\r
+ END\r