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