File: MOVE.LS of Disk: V50/Source/Source-Listing-FORTRAN-2
(Source file text)
RALF V50A 24-JUL-20 PAGE 1
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
00000 1030 JA #ST
00001 0063
#XR, ORG .+10
00012 1517 TEXT +MOVE +
00013 2605
00014 4040
00015 1100 #RET, SETX #XR
00016 0002
00017 1110 SETB #BASE
00020 0023
00021 1030 JA .+3
00022 0024
#BASE, ORG .+6
OBJECT, ORG .+3
WHERE, ORG .+3
00037 0007 HUND, F 100.0
00040 3100
00041 0000
00042 0011 THREHN, F 300.0
00043 2260
00044 0000
FROM, ORG .+3
ORG #BASE+30
00053 0040 FNOP
00054 1030 JA #RET
00055 0015
00056 0040 FNOP
00057 0000 #GOBAK, 0;0
00060 0000
#LBL=.
COMMON PLACOM
ATLOC, ORG .+0702
LINK, ORG .+1130
PLACE, ORG .+0454
FIXED, ORG .+0454
HOLDNG, ORG .+3
ORG #LBL
#RTN, BASE #BASE
00061 1030 JA #GOBAK
00062 0057
00063 0006 #ST, STARTD
00064 0210 0210
00065 6400 FSTA #GOBAK,0
RALF V50A 24-JUL-20 PAGE 1-1
00066 0057
00067 0200 0200
00070 1100 SETX #XR
00071 0002
00072 1110 SETB #BASE
00073 0023
00074 0101 LDX 0,1
00075 0000
00076 6200 FSTA #BASE
00077 0710 FLDA% #BASE,1+
00100 6202 FSTA OBJECT
00101 6400 FSTA #G3
00102 0151
00103 6400 FSTA #G2
00104 0141
00105 0710 FLDA% #BASE,1+
00106 6203 FSTA WHERE
00107 6400 FSTA #G4
00110 0153
00111 0005 STARTF
00112 0602 FLDA% OBJECT
00113 0027 ATX 7
/ IF(OBJECT.GT.100)GOTO 1
00114 2204 FSUB HUND
00115 0025 ATX 5
00116 1060 JGT #1
00117 0125
/ FROM=PLACE(OBJECT)
00120 0470 FLDA PLACE-3,7
00121 2027
00122 6206 FSTA FROM
/ GOTO 2
00123 1030 JA #2
00124 0130
/ 1 FROM=FIXED(OBJECT-100)
00125 0450 #1, FLDA FIXED-3,5
00126 2503
00127 6206 FSTA FROM
/ 2 IF(FROM.GT.0.AND.FROM.LE.300)CALL CARRY(OBJECT,FROM)
00130 1020 #2, JLE #G1
00131 0145
00132 2205 FSUB THREHN
00133 1060 JGT #G1
00134 0145
00135 1130 JSR CARRY
00136 0000
00137 1030 JA .+6
00140 0145
00141 1030 #G2, JA .
00142 0141
00143 1030 JA FROM
00144 0045
/ CALL DROP(OBJECT,WHERE)
00145 1130 #G1, JSR DROP
RALF V50A 24-JUL-20 PAGE 1-2
00146 0000
/ RETURN
/ END
00147 1030 JA #RTN
00150 0061
00151 1030 #G3, JA .
00152 0151
00153 1030 #G4, JA .
00154 0153
RALF V50A 24-JUL-20 PAGE 1-3
NO ERRORS
27 SYMBOLS, NO ABS REFS
# C 00000 #BASE 00023 #GOBAK 00057 #G1 00145
#G2 00141 #G3 00151 #G4 00153 #LBL 00061
#MAIN S 00000 #RET 00015 #RTN 00061 #ST 00063
#XR 00002 #1 00125 #2 00130 ATLOC 00000
CARRY X 00000 DROP X 00000 FIXED 02506 FROM 00045
HOLDNG 03162 HUND 00037 LINK 00702 MOVE S 00155
OBJECT 00031 PLACE 02032 PLACOM C 03165 THREHN 00042
WHERE 00034