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>>
63 <GDECL (I$TRANS-TABLE!-INTERNAL) BYTES>
65 <COND (<NOT <GASSIGNED? I$TRANS-TABLE!-INTERNAL>>
66 <SETG I$TRANS-TABLE!-INTERNAL
68 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
69 0 0 0 0 0 0 0 0 1 0 0 0 0 0 8 5 10 16 12
70 16 13 2 7 21 20 11 20 18 16 19 19 19 19 19 19
71 19 19 19 19 0 9 3 16 7 16 16 16 16 16 16 17
72 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16
73 16 16 16 16 16 4 15 7 16 16 16 16 16 16 16 17
74 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16
75 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>>>>)>>>)
190 <SET POS <REST .POS>>)>
193 <COND (<N==? .LEN .BL> <RETURN .INDEX>)>>>
195 <DEFINE SKIP-MIMA (CHAN NAME "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>>
206 <REPEAT ((BB .B) (STATE ,IN-ATOM))
207 #DECL ((BB) STRING (STATE) FIX)
208 <COND (<AND <SET POS <MEMQ .MCHAR .BB>>
209 <SET PL <LENGTH .POS>>
210 <OR <==? .BL .LEN> <G? .PL <- .BL .LEN>>>>
211 <COND (<G? .PL .MAXL>
212 <COND (<G? .TOTAL-ACCESS 0>
215 <- .TOTAL-ACCESS .ML>>>
216 <SET TOTAL-ACCESS <- .TOTAL-ACCESS .BL>>
224 #DECL ((C1 C2) CHARACTER)
225 <COND (<N==? .C1 .C2>
228 <REST .B <- .BL .PL .ML>>
232 <COND (<EMPTY? <SET POS <REST .POS>>>
233 <COND (<N==? .LEN .BL>
234 <ERROR BAD-MIMA!-ERRORS
236 <SET LEN <CHANNEL-OP .CHAN
240 <+ .TOTAL-ACCESS .BL>>)>
243 <COND (<==? .C2 .ECHAR> <MAPLEAVE>)
245 <SKIP-TRL .C2 .STATE>>
247 <ERROR BAD-MIMA!-ERRORS .NAME>)>)
249 <ERROR BAD-MIMA!-ERRORS .NAME>)
250 (ELSE <SET SPN <REST .SPN>>)>>>
252 <+ .TOTAL-ACCESS <- .BL <LENGTH .POS> -2>>>
254 (ELSE <SET BB <REST .POS>>)>)
256 <COND (<N==? .LEN .BL> <ERROR BAD-MIMA!-ERRORS .NAME>)>>>
258 <DEFINE SKIP-TRL (CHAR STATE "AUX" (TRNS <NTH ,I$TRANS-TABLE!-INTERNAL
259 <+ <ASCII .CHAR> 1>>))
260 #DECL ((CHAR) CHARACTER (TRNS STATE) FIX)
261 <COND (<AND <==? .STATE ,IN-ATOM> <==? .TRNS ,M$$R-EXCL>> ,NEED-MINUS)
262 (<==? .STATE ,NEED-MINUS>
263 <COND (<==? .CHAR !\-> ,IN-ATOM) (ELSE ,NON-ATOM)>)
264 (<==? .STATE ,QUOTE-NEXT> ,IN-ATOM)
265 (<==? .TRNS ,M$$R-BACKS> ,QUOTE-NEXT)
266 (<OR <==? .TRNS ,M$$R-ALPHA>
267 <==? .TRNS ,M$$R-DIGIT>
268 <==? .TRNS ,M$$R-PLUS>
270 <==? .TRNS ,M$$R-STAR>> ,IN-ATOM)