File: DROP.LS of Disk: V50/Source/Source-Listing-FORTRAN-2
(Source file text)
RALF V50A 24-JUL-20 PAGE 1
SECT DROP
/ SUBROUTINE DROP(OBJECT,WHERE)
/ C
/ C PLACE AN OBJECT AT A GIVEN LOC, PREFIXING IT ONTO THE ATLOC LIST.
/ C DECR HOLDNG IF THE OBJECT WAS BEING TOTED.
/ C
/ IMPLICIT INTEGER (A-Z)
/ COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG
/ DIMENSION ATLOC(150)
/ DIMENSION LINK(200)
/ DIMENSION PLACE(100)
/ DIMENSION FIXED(100)
00000 1030 JA #ST
00001 0063
#XR, ORG .+10
00012 0422 TEXT +DROP +
00013 1720
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 0001 ONE, F 1.0
00040 2000
00041 0000
00042 0007 HUND, F 100.0
00043 3100
00044 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 .+702
LINK, ORG .+1130
PLACE, ORG .+454
FIXED, ORG .+454
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
00066 0057
RALF V50A 24-JUL-20 PAGE 1-1
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 index regs
00105 0026 ATX 6
00106 0602 FLDA% OBJECT
00107 0027 ATX 7
/ IF(OBJECT.GT.100)GOTO 1
00110 2205 FSUB HUND
00111 0025 ATX 5 /Save object-100
00112 1060 JGT #1
00113 0133
/ IF(PLACE(OBJECT).EQ.-1)HOLDNG=HOLDNG-1
00114 0204 FLDA ONE
00115 1470 FADD PLACE-3,7
00116 2027
00117 1040 JNE #G1
00120 0126
00121 0400 FLDA HOLDNG
00122 3162
00123 2204 FSUB ONE
00124 6400 FSTA HOLDNG
00125 3162
/ PLACE(OBJECT)=WHERE
00126 0603 #G1, FLDA% WHERE
00127 6470 FSTA PLACE-3,7
00130 2027
/ GOTO 2
00131 1030 JA #2
00132 0136
/ 1 FIXED(OBJECT-100)=WHERE
00133 0603 #1, FLDA% WHERE
00134 6450 FSTA FIXED-3,5
00135 2503
/ 2 IF(WHERE.LE.0)RETURN
00136 1020 #2, JLE #RTN
00137 0061
/ LINK(OBJECT)=ATLOC(WHERE)
00140 0467 #G2, FLDA ATLOC-3,6
00141 7775
00142 6470 FSTA LINK-3,7
00143 0677
/ ATLOC(WHERE)=OBJECT
00144 0037 XTA 7
RALF V50A 24-JUL-20 PAGE 1-2
00145 6467 FSTA ATLOC-3,6
00146 7775
/ RETURN
/ END
00147 1030 JA #RTN
00150 0061
RALF V50A 24-JUL-20 PAGE 1-3
NO ERRORS
22 SYMBOLS, NO ABS REFS
# C 00000 #BASE 00023 #GOBAK 00057 #G1 00126
#G2 00140 #LBL 00061 #MAIN S 00000 #RET 00015
#RTN 00061 #ST 00063 #XR 00002 #1 00133
#2 00136 ATLOC 00000 DROP S 00151 FIXED 02506
HOLDNG 03162 HUND 00042 LINK 00702 OBJECT 00031
ONE 00037 PLACE 02032 PLACOM C 03165 WHERE 00034