| 1 | SECT VOCAB\r |
| 2 | EXTERN SIXOUT\r |
| 3 | / SUBROUTINE VOCAB(ID1,ID2,INIT,V)\r |
| 4 | / OS/8: SUBROUTINE VOCAB(ID, INIT, V)\r |
| 5 | /C\r |
| 6 | /C LOOK UP ID1:ID2 IN THE VOCABULARY (ATAB AND A2TAB)\r |
| 7 | /C Note: A2TAB not used on the '8\r |
| 8 | /C AND RETURN ITS "DEFINITION" (KTAB), OR\r |
| 9 | /C -1 IF NOT FOUND. IF INIT IS POSITIVE, THIS IS AN INIT CALL SETTING\r |
| 10 | /C UP A KEYWORD VARIABLE, AND NOT FINDING IT CONSTITUTES A BUG. IT ALSO MEANS\r |
| 11 | /C THAT ONLY KTAB VALUES WHICH TAKEN OVER 1000 EQUAL INIT MAY BE CONSIDERED.\r |
| 12 | /C (THUS "STEPS", WHICH IS A MOTION VERB AS WELL AS AN OBJECT, MAY BE LOCATED\r |
| 13 | /C AS AN OBJECT.) AND IT ALSO MEANS THE KTAB VALUE IS TAKEN MOD 1000.\r |
| 14 | /C\r |
| 15 | / IMPLICIT INTEGER (A-Z)\r |
| 16 | / COMMON /VOCCOM/ KTAB,ATAB,A2TAB,TABSIZ\r |
| 17 | / DIMENSION KTAB(300),ATAB(300),A2TAB(300)\r |
| 18 | \r |
| 19 | EXTERN BUG\r |
| 20 | EXTERN MOD\r |
| 21 | JA #ST\r |
| 22 | #XR, ORG .+10\r |
| 23 | TEXT +VOCAB+\r |
| 24 | #RET, SETX #XR\r |
| 25 | SETB #BASE\r |
| 26 | JA .+3\r |
| 27 | #BASE, ORG .+3\r |
| 28 | ID, ORG .+3\r |
| 29 | INIT, ORG .+3\r |
| 30 | ONE, F 1.0\r |
| 31 | FOUR, F 4.0\r |
| 32 | THOUS, F 1000.0\r |
| 33 | TWO, F 2.0\r |
| 34 | SIX, F 6.0\r |
| 35 | ORG #BASE+30\r |
| 36 | FNOP\r |
| 37 | JA #RET\r |
| 38 | FNOP\r |
| 39 | #GOBAK, 0;0\r |
| 40 | #VAL, ORG .+6\r |
| 41 | ZERO, F 0.0\r |
| 42 | I, ORG .+3\r |
| 43 | KTABI, ORG .+3\r |
| 44 | K21, F 21.0\r |
| 45 | K5, F 5.0\r |
| 46 | #LBL=.\r |
| 47 | COMMON VOCCOM\r |
| 48 | KTAB, ORG .+1604\r |
| 49 | ATAB, ORG .+1604\r |
| 50 | TABSIZ, ORG .+3\r |
| 51 | ORG #LBL\r |
| 52 | #RTN, BASE #BASE\r |
| 53 | FLDA #VAL\r |
| 54 | JA #GOBAK\r |
| 55 | #ST, STARTD\r |
| 56 | 0210\r |
| 57 | FSTA #GOBAK,0\r |
| 58 | 0200\r |
| 59 | SETX #XR\r |
| 60 | SETB #BASE\r |
| 61 | LDX 0,1\r |
| 62 | FSTA #BASE\r |
| 63 | FLDA% #BASE,1+\r |
| 64 | FSTA ID\r |
| 65 | FLDA% #BASE,1+\r |
| 66 | FSTA INIT\r |
| 67 | STARTF\r |
| 68 | FLDA% INIT\r |
| 69 | FSTA INIT\r |
| 70 | FLDA% ID\r |
| 71 | FSTA ID\r |
| 72 | / DO 1 I=1,TABSIZ\r |
| 73 | FLDA ONE\r |
| 74 | FSTA I\r |
| 75 | \r |
| 76 | / IF(KTAB(I).EQ.-1)GOTO 2\r |
| 77 | #G0001, FLDA I\r |
| 78 | ATX 7\r |
| 79 | FLDA KTAB-3,7\r |
| 80 | FSTA KTABI\r |
| 81 | FADD ONE\r |
| 82 | JEQ #2\r |
| 83 | / IF(INIT.GE.0.AND.KTAB(I)/1000.NE.INIT)GOTO 1\r |
| 84 | FLDA INIT\r |
| 85 | JLT #M1\r |
| 86 | FLDA KTABI\r |
| 87 | FDIV THOUS\r |
| 88 | EXTERN #FIX\r |
| 89 | JSA #FIX\r |
| 90 | FSUB INIT\r |
| 91 | JNE #1\r |
| 92 | / IF(ATAB(I).EQ.ID1 .AND. A2TAB(I).EQ.ID2)GOTO 3\r |
| 93 | / OS/8: IF(ATAB(I).EQ.ID)GOTO 3\r |
| 94 | #M1, FLDA ATAB-0003,7\r |
| 95 | FSUB ID\r |
| 96 | JEQ #3\r |
| 97 | /1 CONTINUE\r |
| 98 | / do loop end\r |
| 99 | #1, FLDA I\r |
| 100 | FADD ONE\r |
| 101 | FSTA I\r |
| 102 | FSUB TABSIZ\r |
| 103 | JLE #G0001\r |
| 104 | / CALL BUG(21)\r |
| 105 | JSR BUG\r |
| 106 | JA .+0004\r |
| 107 | JA K21\r |
| 108 | \r |
| 109 | /2 V=-1\r |
| 110 | #2, FLDA ONE\r |
| 111 | FNEG\r |
| 112 | FSTA #VAL\r |
| 113 | / IF(INIT.LT.0)RETURN\r |
| 114 | FLDA INIT\r |
| 115 | JLT #RTN\r |
| 116 | \r |
| 117 | / TYPE 100,ID\r |
| 118 | #G0002, JSR SIXOUT\r |
| 119 | JA .+10\r |
| 120 | JA #100\r |
| 121 | JA ZERO\r |
| 122 | JA TWO\r |
| 123 | \r |
| 124 | JSR SIXOUT\r |
| 125 | JA .+10\r |
| 126 | JA ID\r |
| 127 | JA TWO\r |
| 128 | JA ONE\r |
| 129 | \r |
| 130 | / CALL BUG(5)\r |
| 131 | JSR BUG\r |
| 132 | JA .+0004\r |
| 133 | JA K5\r |
| 134 | \r |
| 135 | /3 V=KTAB(I)\r |
| 136 | #3, FLDA KTABI\r |
| 137 | FSTA #VAL\r |
| 138 | / IF(INIT.GE.0)V=MOD(V,1000)\r |
| 139 | FLDA INIT\r |
| 140 | JLT #RTN\r |
| 141 | JSR MOD\r |
| 142 | JA .+0006\r |
| 143 | JA #VAL\r |
| 144 | JA THOUS\r |
| 145 | FSTA #VAL\r |
| 146 | / RETURN\r |
| 147 | / END\r |
| 148 | JA #RTN\r |
| 149 | /100 FORMAT(' KEYWORD = ',2A2)\r |
| 150 | / OS/8: ,A4\r |
| 151 | #100, TEXT 'K]EYWORD = @'\r |
| 152 | END\r |