4 <ENTRY BUILD-INDEX SKIP-MIMA>
8 <SETG BUFFER <ISTRING ,BUFLENGTH>>
10 <SETG MAGIC-CHAR <ASCII 26> ;"Control Z">
18 <SETG WORD-STRING "#WORD " ;"Comes before hash codes">
20 <SETG MAGIC-STRING "<SETG " ;"Comes before MSUBRs and IMSUBRs">
22 <SETG MAGIC-LENGTH <LENGTH ,MAGIC-STRING>>
24 <SETG MAGIC-MAX <- ,BUFLENGTH ,MAGIC-LENGTH>>
26 <SETG MAGIC-STRING2 "<END " ;"Comes at end of MIMAs">
28 <SETG MAGIC-LENGTH2 <LENGTH ,MAGIC-STRING2>>
30 <SETG MAGIC-MAX2 <- ,BUFLENGTH ,MAGIC-LENGTH2>>
65 <GDECL (I$TRANS-TABLE!-INTERNAL) BYTES>
67 <COND (<NOT <GASSIGNED? I$TRANS-TABLE!-INTERNAL>>
68 <SETG I$TRANS-TABLE!-INTERNAL
70 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0
71 0 0 0 8 5 10 16 12 16 13 2 7 21 20 11 20 18 16 19 19 19 19 19
72 19 19 19 19 19 0 9 3 16 7 16 16 16 16 16 16 17 16 16 16 16 16
73 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 4 15 7 16 16
74 16 16 16 16 16 17 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16
75 16 16 16 16 16 16 6 14 7 16 16>>)>
77 <DEFMAC GET-ACCESS ('CHAN)
78 <COND (<GASSIGNED? NEW-CHANNEL-TYPE> <FORM ACCESS .CHAN>)
79 (ELSE <FORM 17 .CHAN>)>>
81 <DEFINE BUILD-INDEX (CHAN OBL
82 "AUX" (B ,BUFFER) (BL ,BUFLENGTH) (CHAR ,MAGIC-CHAR)
83 (MAXL ,MAGIC-MAX) (TOTAL-ACCESS <- .BL>)
84 (MS ,MAGIC-STRING) (ML ,MAGIC-LENGTH)
85 (LC1 ,LAST-CHAR1) (LC2 ,LAST-CHAR2)
86 (LC3 ,LAST-CHAR3) SL (WS ,WORD-STRING)
88 #DECL ((CHAN) CHANNEL (WS MS B) STRING (WRD ML BL MAXL TOTAL-ACCESS SL) FIX
89 (OBL) OBLIST (CHAR LC1 LC2 LC3) CHARACTER)
90 <REPEAT OUTER (START PL LEN POS (IM-POS <>) (INDEX ()) NAMESTR NAME-ATOM)
91 #DECL ((PL LEN) FIX (POS) <OR FALSE STRING> (START) STRING)
92 <SET LEN <CHANNEL-OP .CHAN READ-BUFFER .B>>
93 <SET TOTAL-ACCESS <+ .TOTAL-ACCESS .BL>>
97 (<AND <SET POS <MEMQ .CHAR .BB>>
98 <SET PL <LENGTH .POS>>
99 <OR <==? .LEN .BL> <G? .PL <- .BL .LEN>>>>
100 <COND (<G? .PL .MAXL> ;"Foo! must back access"
101 <COND (<G? .TOTAL-ACCESS 0>
102 <ACCESS .CHAN <SET TOTAL-ACCESS <- .TOTAL-ACCESS .ML>>>
103 <SET TOTAL-ACCESS <- .TOTAL-ACCESS .BL>>
105 (ELSE ;"Must be bogus char"
106 <SET BB <REST .POS>> <AGAIN>)>)>
107 <SET SL <LENGTH <SET START <REST .B <- .BL .PL .ML>>>>>
108 <SET SETG-OK <SET WORD-OK T>>
112 #DECL ((C1 C2 C3) CHARACTER)
113 <COND (<N==? .C1 .C2> <SET SETG-OK <>>)>
114 <COND (<N==? .C1 .C3> <SET WORD-OK <>>)>
122 <COND (<EMPTY? <SET POS <REST .POS>>>
125 <ERROR BAD-FILE!-ERRORS .CHAN>)>
126 <SET LEN <CHANNEL-OP .CHAN READ-BUFFER .B>>
127 <SET TOTAL-ACCESS <+ .TOTAL-ACCESS .BL>>
129 <COND (<OR <==? <SET CH <1 .POS>> <ASCII 32>>
133 <SET NAME-ATOM <OR <LOOKUP .NAMESTR .OBL> <INSERT .NAMESTR .OBL>>>
138 (<SET POS <MEMQ .LC1 .POS>>
139 <SET POS <REST .POS>>
142 <SET LEN <CHANNEL-OP .CHAN READ-BUFFER .B>>
144 <SET TOTAL-ACCESS <+ .TOTAL-ACCESS .BL>>)>
145 <COND (<L=? <ASCII <SET CH <1 .POS>>> 32>
146 <SET POS <REST .POS>>
148 <COND (<N==? <1 .POS> .LC2> <AGAIN>)>
149 <SET POS <REST .POS>>
152 <SET LEN <CHANNEL-OP .CHAN READ-BUFFER .B>>
154 <SET TOTAL-ACCESS <+ .TOTAL-ACCESS .BL>>)>
155 <COND (<L=? <ASCII <SET CH <1 .POS>>> 32>
156 <SET POS <REST .POS>>
158 <COND (<N==? <1 .POS> .LC3> <AGAIN>)>
159 <SET POS <REST .POS>>)
161 <SET LEN <CHANNEL-OP .CHAN READ-BUFFER .B>>
163 <SET TOTAL-ACCESS <+ .TOTAL-ACCESS .BL>>
166 ((.NAME-ATOM .IM-POS <+ .TOTAL-ACCESS <- .BL <LENGTH .POS>>>
167 !<COND (<ASSIGNED? WRD> (<CHTYPE .WRD WORD>))
171 (ELSE <SET IM-POS <+ .TOTAL-ACCESS <- .BL .SL>>>)>)
176 <COND (<EMPTY? <SET POS <REST .POS>>>
179 <ERROR BAD-FILE!-ERRORS .CHAN>)>
180 <SET LEN <CHANNEL-OP .CHAN READ-BUFFER .B>>
181 <SET TOTAL-ACCESS <+ .TOTAL-ACCESS .BL>>
183 <COND (<==? <SET CH <1 .POS>> !\*>
184 <COND (.WORD-OK <SET WORD-OK <>>)
187 <SET WRD <ORB <LSH .WRD 3>
188 <- <ASCII .CH> <ASCII !\0>>>>)>>>)
189 (ELSE <SET POS <REST .POS>>)>
192 <COND (<N==? .LEN .BL> <RETURN .INDEX>)>>>
194 <DEFINE SKIP-MIMA (CHAN NAME "OPT" (FUDGE -2)
195 "AUX" (MCHAR ,MAGIC-CHAR) (MS ,MAGIC-STRING2)
196 (ML ,MAGIC-LENGTH2) (MAXL ,MAGIC-MAX2)
197 (SPN <SPNAME .NAME>) (ECHAR ,LAST-CHAR3))
198 #DECL ((CHAN) CHANNEL (NAME) ATOM (MS) STRING (MAXL ML) FIX
199 (MCHAR ECHAR) CHARACTER)
200 <REPEAT OUTER ((B ,BUFFER) (BL ,BUFLENGTH) POS PL LEN
201 (TOTAL-ACCESS <- <GET-ACCESS .CHAN> .BL>))
202 #DECL ((B) STRING (LEN PL BL TOTAL-ACCESS) FIX
203 (POS) <OR FALSE STRING>)
204 <SET LEN <CHANNEL-OP .CHAN READ-BUFFER .B>>
205 <SET TOTAL-ACCESS <+ .TOTAL-ACCESS .BL>> ;"Point to first character
207 <REPEAT ((BB .B) (STATE ,IN-ATOM))
208 #DECL ((BB) STRING (STATE) FIX)
209 <COND (<AND <SET POS <MEMQ .MCHAR .BB>>
210 <SET PL <LENGTH .POS>>
211 <OR <==? .BL .LEN> <G? .PL <- .BL .LEN>>>>
212 <COND (<G? .PL .MAXL>
213 ; "Got hit too close to beginning of buffer"
214 <COND (<G? .TOTAL-ACCESS 0>
215 ; "Already read at least one buffer,
216 so back up a bit and try again."
219 <- .TOTAL-ACCESS .ML>>>
220 <SET TOTAL-ACCESS <- .TOTAL-ACCESS .BL>>
228 #DECL ((C1 C2) CHARACTER)
229 <COND (<N==? .C1 .C2>
232 <REST .B <- .BL .PL .ML>>
234 ; "Succeed if ^Z is actually <END ^Z..., then
235 check the name of the function to make sure
239 <COND (<EMPTY? <SET POS <REST .POS>>>
240 <COND (<N==? .LEN .BL>
241 <ERROR BAD-MIMA!-ERRORS
243 <SET LEN <CHANNEL-OP .CHAN
247 <+ .TOTAL-ACCESS .BL>>)>
250 <COND (<==? .C2 .ECHAR> <MAPLEAVE>)
252 <SKIP-TRL .C2 .STATE>>
254 <ERROR BAD-MIMA!-ERRORS .NAME>)>)
256 <ERROR BAD-MIMA!-ERRORS .NAME>)
257 (ELSE <SET SPN <REST .SPN>>)>>>
258 ; "POS points to > closing <END ^ZFCNNAME>;
259 TOTAL-ACCESS is character number of beginning
262 <+ .TOTAL-ACCESS <- .BL <LENGTH .POS>
265 (ELSE <SET BB <REST .POS>>)>)
267 ; "Come here when went past end of good buffer"
269 <COND (<N==? .LEN .BL> <ERROR BAD-MIMA!-ERRORS .NAME>)>>>
271 <DEFINE SKIP-TRL (CHAR STATE "AUX" (TRNS <NTH ,I$TRANS-TABLE!-INTERNAL
272 <+ <ASCII .CHAR> 1>>))
273 #DECL ((CHAR) CHARACTER (TRNS STATE) FIX)
274 <COND (<AND <==? .STATE ,IN-ATOM> <==? .TRNS ,M$$R-EXCL>> ,NEED-MINUS)
275 (<==? .STATE ,NEED-MINUS>
276 <COND (<==? .CHAR !\-> ,IN-ATOM) (ELSE ,NON-ATOM)>)
277 (<==? .STATE ,QUOTE-NEXT> ,IN-ATOM)
278 (<==? .TRNS ,M$$R-BACKS> ,QUOTE-NEXT)
279 (<OR <==? .TRNS ,M$$R-ALPHA>
280 <==? .TRNS ,M$$R-DIGIT>
281 <==? .TRNS ,M$$R-PLUS>
283 <==? .TRNS ,M$$R-STAR>> ,IN-ATOM)