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