SECT MOVE / SUBROUTINE MOVE(OBJECT,WHERE) / C / C PLACE ANY OBJECT ANYWHERE BY PICKING IT UP AND DROPPING IT. MAY ALREADY BE / C TOTING, IN WHICH CASE THE CARRY IS A NO-OP. MUSTN'T PICK UP OBJECTS WHICH / C ARE NOT AT ANY LOC, SINCE CARRY WANTS TO REMOVE OBJECTS FROM ATLOC CHAINS. / C / IMPLICIT INTEGER (A-Z) / COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG / DIMENSION ATLOC(150),LINK(200),PLACE(100),FIXED(100) / C EXTERN CARRY EXTERN DROP JA #ST #XR, ORG .+10 TEXT +MOVE + #RET, SETX #XR SETB #BASE JA .+3 #BASE, ORG .+6 OBJECT, ORG .+3 WHERE, ORG .+3 HUND, F 100.0 THREHN, F 300.0 FROM, ORG .+3 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 FSTA #G3 FSTA #G2 FLDA% #BASE,1+ FSTA WHERE FSTA #G4 STARTF FLDA% OBJECT ATX 7 / IF(OBJECT.GT.100)GOTO 1 FSUB HUND ATX 5 JGT #1 / FROM=PLACE(OBJECT) FLDA PLACE-3,7 FSTA FROM / GOTO 2 JA #2 / 1 FROM=FIXED(OBJECT-100) #1, FLDA FIXED-3,5 FSTA FROM / 2 IF(FROM.GT.0.AND.FROM.LE.300)CALL CARRY(OBJECT,FROM) #2, JLE #G1 FSUB THREHN JGT #G1 JSR CARRY JA .+6 #G2, JA . JA FROM / CALL DROP(OBJECT,WHERE) #G1, JSR DROP / RETURN / END JA #RTN #G3, JA . #G4, JA . END