File: VOCAB.LS of Disk: V50/Source/Source-Listing-FORTRAN-2
(Source file text)
RALF V50A 24-JUL-20 PAGE 1
SECT VOCAB
EXTERN SIXOUT
/ SUBROUTINE VOCAB(ID1,ID2,INIT,V)
/ OS/8: SUBROUTINE VOCAB(ID, INIT, V)
/C
/C LOOK UP ID1:ID2 IN THE VOCABULARY (ATAB AND A2TAB)
/C Note: A2TAB not used on the '8
/C AND RETURN ITS "DEFINITION" (KTAB), OR
/C -1 IF NOT FOUND. IF INIT IS POSITIVE, THIS IS AN INIT CALL SETTING
/C UP A KEYWORD VARIABLE, AND NOT FINDING IT CONSTITUTES A BUG. IT ALSO MEANS
/C THAT ONLY KTAB VALUES WHICH TAKEN OVER 1000 EQUAL INIT MAY BE CONSIDERED.
/C (THUS "STEPS", WHICH IS A MOTION VERB AS WELL AS AN OBJECT, MAY BE LOCATED
/C AS AN OBJECT.) AND IT ALSO MEANS THE KTAB VALUE IS TAKEN MOD 1000.
/C
/ IMPLICIT INTEGER (A-Z)
/ COMMON /VOCCOM/ KTAB,ATAB,A2TAB,TABSIZ
/ DIMENSION KTAB(300),ATAB(300),A2TAB(300)
EXTERN BUG
EXTERN MOD
00000 1030 JA #ST
00001 0111
#XR, ORG .+10
00012 2617 TEXT +VOCAB+
00013 0301
00014 0200
00015 1100 #RET, SETX #XR
00016 0002
00017 1110 SETB #BASE
00020 0023
00021 1030 JA .+3
00022 0024
#BASE, ORG .+3
ID, ORG .+3
INIT, ORG .+3
00034 0001 ONE, F 1.0
00035 2000
00036 0000
00037 0003 FOUR, F 4.0
00040 2000
00041 0000
00042 0012 THOUS, F 1000.0
00043 3720
00044 0000
00045 0002 TWO, F 2.0
00046 2000
00047 0000
00050 0003 SIX, F 6.0
00051 3000
00052 0000
ORG #BASE+30
00053 0040 FNOP
00054 1030 JA #RET
00055 0015
00056 0040 FNOP
00057 0000 #GOBAK, 0;0
RALF V50A 24-JUL-20 PAGE 1-1
00060 0000
#VAL, ORG .+6
00067 0000 ZERO, F 0.0
00070 0000
00071 0000
I, ORG .+3
KTABI, ORG .+3
00100 0005 K21, F 21.0
00101 2500
00102 0000
00103 0003 K5, F 5.0
00104 2400
00105 0000
#LBL=.
COMMON VOCCOM
KTAB, ORG .+1604
ATAB, ORG .+1604
TABSIZ, ORG .+3
ORG #LBL
#RTN, BASE #BASE
00106 0212 FLDA #VAL
00107 1030 JA #GOBAK
00110 0057
00111 0006 #ST, STARTD
00112 0210 0210
00113 6400 FSTA #GOBAK,0
00114 0057
00115 0200 0200
00116 1100 SETX #XR
00117 0002
00120 1110 SETB #BASE
00121 0023
00122 0101 LDX 0,1
00123 0000
00124 6200 FSTA #BASE
00125 0710 FLDA% #BASE,1+
00126 6201 FSTA ID
00127 0710 FLDA% #BASE,1+
00130 6202 FSTA INIT
00131 0005 STARTF
00132 0602 FLDA% INIT
00133 6202 FSTA INIT
00134 0601 FLDA% ID
00135 6201 FSTA ID
/ DO 1 I=1,TABSIZ
00136 0203 FLDA ONE
00137 6215 FSTA I
/ IF(KTAB(I).EQ.-1)GOTO 2
00140 0215 #G0001, FLDA I
00141 0027 ATX 7
00142 0477 FLDA KTAB-3,7
00143 7775
00144 6216 FSTA KTABI
00145 1203 FADD ONE
00146 1000 JEQ #2
RALF V50A 24-JUL-20 PAGE 1-2
00147 0204
/ IF(INIT.GE.0.AND.KTAB(I)/1000.NE.INIT)GOTO 1
00150 0202 FLDA INIT
00151 1050 JLT #M1
00152 0162
00153 0216 FLDA KTABI
00154 3205 FDIV THOUS
EXTERN #FIX
00155 1120 JSA #FIX
00156 0000
00157 2202 FSUB INIT
00160 1040 JNE #1
00161 0167
/ IF(ATAB(I).EQ.ID1 .AND. A2TAB(I).EQ.ID2)GOTO 3
/ OS/8: IF(ATAB(I).EQ.ID)GOTO 3
00162 0470 #M1, FLDA ATAB-0003,7
00163 1601
00164 2201 FSUB ID
00165 1000 JEQ #3
00166 0244
/1 CONTINUE
/ do loop end
00167 0215 #1, FLDA I
00170 1203 FADD ONE
00171 6215 FSTA I
00172 2400 FSUB TABSIZ
00173 3410
00174 1020 JLE #G0001
00175 0140
/ CALL BUG(21)
00176 1130 JSR BUG
00177 0000
00200 1030 JA .+0004
00201 0204
00202 1030 JA K21
00203 0100
/2 V=-1
00204 0203 #2, FLDA ONE
00205 0003 FNEG
00206 6212 FSTA #VAL
/ IF(INIT.LT.0)RETURN
00207 0202 FLDA INIT
00210 1050 JLT #RTN
00211 0106
/ TYPE 100,ID
00212 1130 #G0002, JSR SIXOUT
00213 0000
00214 1030 JA .+10
00215 0224
00216 1030 JA #100
00217 0264
00220 1030 JA ZERO
00221 0067
00222 1030 JA TWO
RALF V50A 24-JUL-20 PAGE 1-3
00223 0045
00224 1130 JSR SIXOUT
00225 0000
00226 1030 JA .+10
00227 0236
00230 1030 JA ID
00231 0026
00232 1030 JA TWO
00233 0045
00234 1030 JA ONE
00235 0034
/ CALL BUG(5)
00236 1130 JSR BUG
00237 0000
00240 1030 JA .+0004
00241 0244
00242 1030 JA K5
00243 0103
/3 V=KTAB(I)
00244 0216 #3, FLDA KTABI
00245 6212 FSTA #VAL
/ IF(INIT.GE.0)V=MOD(V,1000)
00246 0202 FLDA INIT
00247 1050 JLT #RTN
00250 0106
00251 1130 JSR MOD
00252 0000
00253 1030 JA .+0006
00254 0261
00255 1030 JA #VAL
00256 0061
00257 1030 JA THOUS
00260 0042
00261 6212 FSTA #VAL
/ RETURN
/ END
00262 1030 JA #RTN
00263 0106
/100 FORMAT(' KEYWORD = ',2A2)
/ OS/8: ,A4
00264 1335 #100, TEXT 'K]EYWORD = @'
00265 0531
00266 2717
00267 2204
00270 4075
00271 4000
RALF V50A 24-JUL-20 PAGE 1-4
NO ERRORS
36 SYMBOLS, NO ABS REFS
# C 00000 #BASE 00023 #FIX X 00000 #GOBAK 00057
#G0001 00140 #G0002 00212 #LBL 00106 #MAIN S 00000
#M1 00162 #RET 00015 #RTN 00106 #ST 00111
#VAL 00061 #XR 00002 #1 00167 #100 00264
#2 00204 #3 00244 ATAB 01604 BUG X 00000
FOUR 00037 I 00072 ID 00026 INIT 00031
KTAB 00000 KTABI 00075 K21 00100 K5 00103
MOD X 00000 ONE 00034 SIX 00050 SIXOUT X 00000
TABSIZ 03410 THOUS 00042 TWO 00045 VOCAB S 00272
VOCCOM C 03413 ZERO 00067