--- /dev/null
+ SECT VOCAB\r
+ EXTERN SIXOUT\r
+/ SUBROUTINE VOCAB(ID1,ID2,INIT,V)\r
+/ OS/8: SUBROUTINE VOCAB(ID, INIT, V)\r
+/C\r
+/C LOOK UP ID1:ID2 IN THE VOCABULARY (ATAB AND A2TAB)\r
+/C Note: A2TAB not used on the '8\r
+/C AND RETURN ITS "DEFINITION" (KTAB), OR\r
+/C -1 IF NOT FOUND. IF INIT IS POSITIVE, THIS IS AN INIT CALL SETTING\r
+/C UP A KEYWORD VARIABLE, AND NOT FINDING IT CONSTITUTES A BUG. IT ALSO MEANS\r
+/C THAT ONLY KTAB VALUES WHICH TAKEN OVER 1000 EQUAL INIT MAY BE CONSIDERED.\r
+/C (THUS "STEPS", WHICH IS A MOTION VERB AS WELL AS AN OBJECT, MAY BE LOCATED\r
+/C AS AN OBJECT.) AND IT ALSO MEANS THE KTAB VALUE IS TAKEN MOD 1000.\r
+/C\r
+/ IMPLICIT INTEGER (A-Z)\r
+/ COMMON /VOCCOM/ KTAB,ATAB,A2TAB,TABSIZ\r
+/ DIMENSION KTAB(300),ATAB(300),A2TAB(300)\r
+\r
+ EXTERN BUG\r
+ EXTERN MOD\r
+ JA #ST\r
+#XR, ORG .+10\r
+ TEXT +VOCAB+\r
+#RET, SETX #XR\r
+ SETB #BASE\r
+ JA .+3\r
+#BASE, ORG .+3\r
+ID, ORG .+3\r
+INIT, ORG .+3\r
+ONE, F 1.0\r
+FOUR, F 4.0\r
+THOUS, F 1000.0\r
+TWO, F 2.0\r
+SIX, F 6.0\r
+ ORG #BASE+30\r
+ FNOP\r
+ JA #RET\r
+ FNOP\r
+#GOBAK, 0;0\r
+#VAL, ORG .+6\r
+ZERO, F 0.0\r
+I, ORG .+3\r
+KTABI, ORG .+3\r
+K21, F 21.0\r
+K5, F 5.0\r
+ #LBL=.\r
+ COMMON VOCCOM\r
+KTAB, ORG .+1604\r
+ATAB, ORG .+1604\r
+TABSIZ, ORG .+3\r
+ ORG #LBL\r
+#RTN, BASE #BASE\r
+ FLDA #VAL\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 ID\r
+ FLDA% #BASE,1+\r
+ FSTA INIT\r
+ STARTF\r
+ FLDA% INIT\r
+ FSTA INIT\r
+ FLDA% ID\r
+ FSTA ID\r
+/ DO 1 I=1,TABSIZ\r
+ FLDA ONE\r
+ FSTA I\r
+\r
+/ IF(KTAB(I).EQ.-1)GOTO 2\r
+#G0001, FLDA I\r
+ ATX 7\r
+ FLDA KTAB-3,7\r
+ FSTA KTABI\r
+ FADD ONE\r
+ JEQ #2\r
+/ IF(INIT.GE.0.AND.KTAB(I)/1000.NE.INIT)GOTO 1\r
+ FLDA INIT\r
+ JLT #M1\r
+ FLDA KTABI\r
+ FDIV THOUS\r
+ EXTERN #FIX\r
+ JSA #FIX\r
+ FSUB INIT\r
+ JNE #1\r
+/ IF(ATAB(I).EQ.ID1 .AND. A2TAB(I).EQ.ID2)GOTO 3\r
+/ OS/8: IF(ATAB(I).EQ.ID)GOTO 3\r
+#M1, FLDA ATAB-0003,7\r
+ FSUB ID\r
+ JEQ #3\r
+/1 CONTINUE\r
+/ do loop end\r
+#1, FLDA I\r
+ FADD ONE\r
+ FSTA I\r
+ FSUB TABSIZ\r
+ JLE #G0001\r
+/ CALL BUG(21)\r
+ JSR BUG\r
+ JA .+0004\r
+ JA K21\r
+\r
+/2 V=-1\r
+#2, FLDA ONE\r
+ FNEG\r
+ FSTA #VAL\r
+/ IF(INIT.LT.0)RETURN\r
+ FLDA INIT\r
+ JLT #RTN\r
+\r
+/ TYPE 100,ID\r
+#G0002, JSR SIXOUT\r
+ JA .+10\r
+ JA #100\r
+ JA ZERO\r
+ JA TWO\r
+\r
+ JSR SIXOUT\r
+ JA .+10\r
+ JA ID\r
+ JA TWO\r
+ JA ONE\r
+\r
+/ CALL BUG(5)\r
+ JSR BUG\r
+ JA .+0004\r
+ JA K5\r
+\r
+/3 V=KTAB(I)\r
+#3, FLDA KTABI\r
+ FSTA #VAL\r
+/ IF(INIT.GE.0)V=MOD(V,1000)\r
+ FLDA INIT\r
+ JLT #RTN\r
+ JSR MOD\r
+ JA .+0006\r
+ JA #VAL\r
+ JA THOUS\r
+ FSTA #VAL\r
+/ RETURN\r
+/ END\r
+ JA #RTN\r
+/100 FORMAT(' KEYWORD = ',2A2)\r
+/ OS/8: ,A4\r
+#100, TEXT 'K]EYWORD = @'\r
+ END\r