disk8: Initial commit
[pdp8.git] / sw / adventure / VOCAB.RA
CommitLineData
84b5715c
PH
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
28ID, ORG .+3\r
29INIT, ORG .+3\r
30ONE, F 1.0\r
31FOUR, F 4.0\r
32THOUS, F 1000.0\r
33TWO, F 2.0\r
34SIX, 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
41ZERO, F 0.0\r
42I, ORG .+3\r
43KTABI, ORG .+3\r
44K21, F 21.0\r
45K5, F 5.0\r
46 #LBL=.\r
47 COMMON VOCCOM\r
48KTAB, ORG .+1604\r
49ATAB, ORG .+1604\r
50TABSIZ, 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