File: CARRY.LS of Disk: V50/Source/Source-Listing-FORTRAN-2
(Source file text)
RALF V50A 24-JUL-20 PAGE 1
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
00000 1030 JA #ST
00001 0063
#XR, ORG .+10
00012 0301 TEXT +CARRY+
00013 2222
00014 3100
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 0001 ONE, F 1.0
00043 2000
00044 0000
00045 0001 M1, F -1.0
00046 6000
00047 0000
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
RALF V50A 24-JUL-20 PAGE 1-1
00065 6400 FSTA #GOBAK,0
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 0710 FLDA% #BASE,1+
00102 6203 FSTA WHERE
00103 0005 STARTF
00104 0603 FLDA% WHERE /Pre-load indexes
00105 0026 ATX 6
00106 0602 FLDA% OBJECT
00107 0027 ATX 7 /Fall thru with OBJECT in AC
/ IF(OBJECT.GT.100)GOTO 5
00110 2204 FSUB HUND
00111 1060 JGT #5
00112 0126
/ IF(PLACE(OBJECT).EQ.-1)RETURN
00113 0205 FLDA ONE
00114 1470 FADD PLACE-3,7
00115 2027
00116 1000 JEQ #RTN
00117 0061
/ PLACE(OBJECT)=-1
00120 0206 FLDA M1
00121 6470 FSTA PLACE-3,7
00122 2027
/ HOLDNG=HOLDNG+1
00123 0205 FLDA ONE
00124 5400 FADDM HOLDNG
00125 3162
/ 5 IF(ATLOC(WHERE).NE.OBJECT)GOTO 6
00126 0467 #5, FLDA ATLOC-3,6
00127 7775
00130 2602 FSUB% OBJECT
00131 1040 JNE #6
00132 0141
/ ATLOC(WHERE)=LINK(OBJECT)
00133 0470 FLDA LINK-3,7
00134 0677
00135 6467 FSTA ATLOC-3,6
00136 7775
/ RETURN
00137 1030 JA #RTN
00140 0061
/ 6 TEMP=ATLOC(WHERE)
00141 0467 #6, FLDA ATLOC-3,6
00142 7775
RALF V50A 24-JUL-20 PAGE 1-2
/ 7 IF(LINK(TEMP).EQ.OBJECT)GOTO 8
00143 0025 #7, ATX 5
00144 0450 FLDA LINK-3,5
00145 0677
00146 2602 FSUB% OBJECT
00147 1000 JEQ #8
00150 0155
/ TEMP=LINK(TEMP)
00151 0450 FLDA LINK-3,5
00152 0677
/ GOTO 7
00153 1030 JA #7
00154 0143
/ 8 LINK(TEMP)=LINK(OBJECT)
00155 0470 #8, FLDA LINK-3,7
00156 0677
00157 6450 FSTA LINK-3,5
00160 0677
/ RETURN
/ END
00161 1030 JA #RTN
00162 0061
RALF V50A 24-JUL-20 PAGE 1-3
NO ERRORS
23 SYMBOLS, NO ABS REFS
# C 00000 #BASE 00023 #GOBAK 00057 #LBL 00061
#MAIN S 00000 #RET 00015 #RTN 00061 #ST 00063
#XR 00002 #5 00126 #6 00141 #7 00143
#8 00155 ATLOC 00000 CARRY S 00163 FIXED 02506
HOLDNG 03162 HUND 00037 LINK 00702 M1 00045
OBJECT 00031 ONE 00042 PLACE 02032 PLACOM C 03165
WHERE 00034