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