8 <NEWSTRUC GLUE-INFO VECTOR
11 GLUED-CALL-OK? <OR ATOM FALSE>
15 FINAL-LOC <OR FALSE FIX>
20 <NEWSTRUC CONST-REF VECTOR C-VALUE FIX C-REFS <LIST [REST FIX]>>
22 <EVAL-WHEN ("SUBSYSTEM" "MIMC")
23 <FLOAD "PS:<MIM.20C>MSGLUE-PM.MUD">>
25 <COND (<N==? <PRIMTYPE 1> FIX>
26 <DEFINE FLSH (A B) #DECL ((A B) FIX) <CHTYPE <LSH .A .B> FIX>>
27 <DEFINE FORB ("TUPLE" X) <CHTYPE <ORB !.X> FIX>>
28 <PUTPROP CODE DECL '<<PRIMTYPE UVECTOR> [REST FIX]>>)
32 <PUT-DECL CODE '<<PRIMTYPE UVECTOR> [REST FIX]>>)>
34 <MSETG GLUE-FRM-INS 1>
36 <MSETG GLUE-LOAD-MS-INS 2>
38 <MSETG GLUE-LOAD-ARG 3>
40 <MSETG GLUE-CALL-INS 0>
42 <MSETG INDX-BP <BITS 4 18>>
44 <MSETG AC-BP <BITS 4 23>>
46 <MSETG INS-BP <BITS 9 27>>
48 <MSETG ADDR-BP <BITS 18>>
50 <MSETG FRAME-LOC *220*>
52 <MSETG CALL-LOC *221*>
54 <MSETG GVAL-LOC *160*>
56 <MSETG GASS-LOC *157*>
60 <MSETG SFRAME-LOC 207>
78 <MSETG P-AC <FLSH ,P 23>>
80 <MSETG T-AC <FLSH ,T 23>>
84 <MSETG F-INDX <FLSH ,F 18>>
86 <MSETG F-AC <FLSH ,F 23>>
88 <MSETG TP-INDX <FLSH ,TP 18>>
90 <MSETG TP-AC <FLSH ,TP 23>>
92 <MSETG R-INDX <FLSH ,R 18>>
94 <MSETG IND <FLSH 1 22>>
96 <MSETG JSP <FLSH *265* 27>>
98 <MSETG SKIPL <FLSH *331* 27>>
100 <MSETG HRROI <FLSH *561* 27>>
102 <MSETG PUSH <FLSH *261* 27>>
104 <MSETG XMOVEI <FLSH *415* 27>>
108 <MSETG SUB-INS <FLSH *274* 27>>
110 <MSETG JRST <FLSH *254* 27>>
112 <MSETG SETZ <FLSH *400* 27>>
114 <MSETG PUSHJ <FLSH *260* 27>>
116 <MSETG PUSHJ-GVAL <FORB ,PUSHJ ,P-AC ,IND ,GVAL-LOC>>
118 <MSETG PUSHJ-GASS <FORB ,PUSHJ ,P-AC ,IND ,GASS-LOC>>
120 <MSETG JSP-GVAL <FORB ,JSP ,PC-AC ,IND ,GVAL-LOC>>
122 <MSETG JSP-GASS <FORB ,JSP ,PC-AC ,IND ,GASS-LOC>>
124 <MSETG JSP-ACALL <FORB ,JSP ,PC-AC ,IND ,ACALL-LOC>>
126 <SETG FUNNY-CALLS <UVECTOR ,PUSHJ-GVAL ,PUSHJ-GASS ,JSP-GVAL ,JSP-GASS ,JSP-ACALL>>
128 <GDECL (FUNNY-CALLS) <UVECTOR [REST FIX]>>
130 <MSETG JSP-FRAME <FORB ,JSP ,PC-AC ,IND ,FRAME-LOC>>
132 <MSETG JSP-CALL <FORB ,JSP ,PC-AC ,IND ,CALL-LOC>>
134 <MSETG JSP-SFRAME <FORB ,JSP ,PC-AC ,IND ,SFRAME-LOC>>
136 <MSETG SKIPL-T-1-PARENF <FORB ,SKIPL ,T-AC *777777* ,F-INDX>>
138 <MSETG HRROI-T <FORB ,HRROI ,T-AC ,F-INDX>>
140 <MSETG PUSH-TP-T <FORB ,PUSH ,TP-AC ,T>>
142 <MSETG PUSH-TP-F <FORB ,PUSH ,TP-AC ,F>>
144 <MSETG PUSH-TP-PARENR <FORB ,PUSH ,TP-AC ,R-INDX>>
146 <MSETG XMOVEI-F-1-TP <FORB ,XMOVEI ,F-AC *777777* ,TP-INDX>>
148 <MSETG SUB-F-O2 <FORB ,SUB-INS ,F-AC ,O2>>
150 <MSETG XMOVEI-TP <FORB ,XMOVEI ,F-AC ,TP-INDX>>
152 <MSETG JRST-R <FORB ,JRST ,R-INDX>>
154 <MSETG SETZ-R <FORB ,SETZ ,R-INDX>>
156 <NEWTYPE GLUED-ATOM ATOM>
158 <GDECL (ALL-PACKAGES ALL-P OBJ-LIST OBJ-PTR CODE-LIST CODE-PTR) LIST>
160 <GDECL (CONST-PTR CONST-LIST) <LIST [REST CONST-REF]>>
162 <DEFINE FILE-GLUE ("TUPLE" FILES "AUX" C TMP-TXT TMP-CODE (OUTCHAN .OUTCHAN)
163 (EXPFLOAD <AND <ASSIGNED? EXPFLOAD> .EXPFLOAD>) (EST-LNT 0)
164 (FNM1 <GET-NM1 <1 .FILES>>) CP ITM OBP OC (NM2 "MSUBR")
165 (TEMP-FILE? <AND <GASSIGNED? TEMP-FILE?> ,TEMP-FILE?>)
167 #DECL ((FILES) <<PRIMTYPE VECTOR> [REST STRING]> (OUTCHAN) <SPECIAL ANY>
168 (OBP CP) <LIST ANY> (OC C TMP-TXT TMP-CODE) <OR FALSE CHANNEL>
169 (EST-LNT) FIX (NM2) <SPECIAL STRING>)
170 <COND (<AND <SET C <OPEN "READ" <1 .FILES>>>
171 <OR <NOT .TEMP-FILE?>
178 <STRING .FNM1 ".GLUE-CODE">>>>>>
179 <COND (<NOT .TEMP-FILE?>
180 <SET TMP-TXT <SET TMP-CODE <>>>
181 <SETG OBJ-LIST <SETG OBJ-PTR (T)>>)>
182 <SETG CODE-LIST <SET CP <SETG CODE-PTR (T)>>>
183 <SETG CONST-LIST <SETG CONST-PTR (<CHTYPE [0 ()] CONST-REF>)>>
185 <SET FILES <REST .FILES>>
186 <SETG ALL-P <SETG ALL-PACKAGES (T)>
187 <REPEAT (RES IMS) #DECL ((IMS) IMSUBR)
189 <COND (<SET ITM <FINISH-FILE .C .TMP-TXT .EXPFLOAD>>)
193 <COND (.TEMP-FILE? <PRIN1 .ITM .TMP-CODE>)
194 (ELSE <SET OBP ,OBJ-PTR>)>
195 <SET EST-LNT <+ <LENGTH <1 <SET IMS .ITM>>> .EST-LNT>>
196 <COND (<NOT <TYPE? <SET ITM <READ .C EOF>> FIX>>
197 <ERROR NOT-GLUEABLE!-ERRORS>)>
198 <SET RES <READ .C '<ERROR EOF-BAD-MSUBR-FILE!-ERRORS>>>
199 <COND (<NOT <TYPE? <SET RES <EVAL .RES>> MSUBR>>
200 <ERROR MSUBR-DOES-NOT-FOLLOW-IMSUBR!-ERRORS
202 <COND (.TEMP-FILE? <PRIN1 .RES .TMP-CODE>)>
203 <PUTREST .CP <SET CP (<CHTYPE [<2 <CHTYPE .IMS VECTOR>>
204 <2 <CHTYPE .RES VECTOR>>
205 <G=? <CHTYPE .ITM FIX> 0>
206 <3 <CHTYPE .RES VECTOR>>
207 <4 <CHTYPE .RES VECTOR>>
210 <ABS <CHTYPE .ITM FIX>>
211 <ARG-SPEC <3 <CHTYPE .RES
215 <COND (.TEMP-FILE? <GUNASSIGN <2 <CHTYPE .IMS VECTOR>>>)>
216 <PUTPROP <2 <CHTYPE .RES VECTOR>> INFO <1 .CP>>>
217 <COND (<EMPTY? .FILES>
220 <COND (<SET C <OPEN "READ" <1 .FILES>>>
221 <SET FILES <REST .FILES>>
223 (<ERROR .C FILE-MIMOC>)>>
226 <CHANNEL-OP .TMP-TXT ACCESS 0>
227 <CHANNEL-OP .TMP-CODE ACCESS 0>)>
228 <SET OBP <REST ,OBJ-LIST>>
229 <SET CP <REST ,CODE-LIST>>
230 <PROG ((ST <STRING .FNM1 ".GSUBR">))
231 <COND (<OR <NOT <TYPE? .ST STRING>>
232 <NOT <SET OC <OPEN "PRINT" .ST>>>>
233 <SET ST <ERROR CANT-OPEN-OUTPUT!-ERRORS
235 ERRET-CORRECT-NAME!-ERRORS>>
237 <COND (<G? <LENGTH ,ALL-PACKAGES> 3>
238 <REPEAT ((ALL-P:LIST <REST ,ALL-PACKAGES>) NP
239 (OBLIST:<SPECIAL ANY> .OBLIST) ITM:<FORM ATOM>)
240 <COND (<EMPTY? .ALL-P> <RETURN>)>
241 <COND (<==? <1 .ITM> PACKAGE>
243 <SET NP <LOOKUP <2 .ITM> #OBLIST PACKAGE>>)
245 <SET OBLIST (<CHTYPE .NP OBLIST> <ROOT>)>
248 <SET ALL-P <REST .ALL-P>>>)>
249 <REPEAT (INM ITM (FIRST T) (OBLIST .OBLIST))
250 #DECL ((OBLIST) <SPECIAL ANY>)
251 <COND (.TEMP-FILE? <SET ITM <READ .TMP-TXT '<RETURN>>>)
254 <SET OBLIST <GETPROP .OBP BLOCK '.OBLIST>>
255 <SET OBP <REST .OBP>>)
257 <COND (<TYPE? .ITM GLUED-ATOM>
259 <GLUE-IT .CP .TMP-CODE .OC
260 <SET INM <CHTYPE .ITM ATOM>>
263 <WRITE-MSUBR <1 .CP> .OC .INM>
265 (ELSE <PRIN1 .ITM .OC> <CRLF .OC>)>>
268 (<ASSIGNED? TMP-CODE>
277 <DEFINE FINISH-FILE (INCHAN OUTCHAN EXPFLOAD "AUX" (IND '(1)) OBP)
278 #DECL ((INCHAN) CHANNEL (OUTCHAN) <OR CHANNEL FALSE> (EXPFLOAD) <OR ATOM FALSE>
280 <COND (<NOT .OUTCHAN> <SET OBP ,OBJ-PTR>)>
281 <REPEAT (RES ITM NCH (OOBL <LIST !.OBLIST>))
282 <COND (<==? <SET ITM <READ .INCHAN '.IND>> .IND>
283 <COND (<EMPTY? <SETG INCHANS <REST ,INCHANS>>>
284 <COND (<NOT .OUTCHAN> <SETG OBJ-PTR .OBP>)>
286 <SET INCHAN <1 ,INCHANS>>
289 <COND (<AND <TYPE? .ITM FORM>
291 <OR <==? <1 .ITM> PACKAGE> <==? <1 .ITM> ENTRY>>>
292 <PUTREST ,ALL-P <SETG ALL-P (.ITM)>>)
297 <COND (<==? <1 .ITM> FLOAD>
298 <SET NCH <OPEN "READ" !<REST .ITM>>>)
299 (<==? <1 .ITM> L-FLOAD>
300 <SET NCH <L-OPEN <2 .ITM>>>)
307 ERRET-NAME-OR-FALSE!-ERROS>>
308 <COND (<NOT <SET NCH <OPEN "READ" .NM>>>
311 <RETURN <> .OUT>)>>)>
314 <SETG INCHANS (.NCH !,INCHANS)>)
317 <COND (<NOT <ASSIGNED? NCH>> <SET RES <EVAL .ITM>>)>
318 <COND (<AND .RES <TYPE? .RES IMSUBR>>
320 <PRIN1 <CHTYPE <2 .RES> GLUED-ATOM> .OUTCHAN>)
323 <SET OBP (<CHTYPE <2 .RES> GLUED-ATOM>)>>)>
324 <COND (<NOT .OUTCHAN> <SETG OBJ-PTR .OBP>)>
326 (.OUTCHAN <PRIN1 .ITM .OUTCHAN>)
328 <PUTREST .OBP <SET OBP (.ITM)>>
329 <COND (<N=? .OOBL .OBLIST>
330 <PUTPROP .OBP BLOCK <SET OOBL <LIST !.OBLIST>>>)>)>)>>>
332 <SETG OUTPUT-LENGTH 1024>
334 <GDECL (OUTPUT-LENGTH) FIX>
336 <SETG OUTPUT-BUFFER <ISTRING ,OUTPUT-LENGTH>>
338 <DEFINE GLUE-IT (CP CHAN? OC NAM LNT
339 "AUX" (IMS (T)) (IMP .IMS) (NUM 0)
340 (NEW-CODE <IUVECTOR <+ </ .LNT 2> .LNT>>)
341 (OB ,OUTPUT-BUFFER) CNUM (CHRS 0))
342 #DECL ((IMSP IMP) LIST (CP) <LIST [REST GLUE-INFO]> (CHRS OL LNT NUM) FIX
345 <FUNCTION (G-O) #DECL ((G-O) GLUE-INFO)
346 <FINAL-LOC .G-O .NUM>
348 <FUNCTION (LOC) #DECL ((LOC) FIX)
351 <ORB <NTH .NEW-CODE .LOC> .NUM>>>
354 <SET NUM <DO-ONE-GLUE <COND (.CHAN? <READ .CHAN?>)
355 (ELSE ,<IMSUBR-NAME .G-O>)>
361 <SET IMP <REST .IMS <- <LENGTH .IMS> 1>>>>
365 <FUNCTION (C) #DECL ((C) CONST-REF)
367 <FUNCTION (LOC) #DECL ((LOC) FIX)
368 <PUT .NEW-CODE .LOC <ORB <NTH .NEW-CODE .LOC>
371 <SET CNUM <+ .CNUM 1>>
376 <PRINC " #IMSUBR [|" .OC>
377 <PRINTBYTE <LSH .CNUM -16>>
378 <PRINTBYTE <LSH .CNUM -8>>
383 <REPEAT ((I 4)) #DECL ((I) FIX)
384 <PRINTBYTE <SET WRD <ROT .WRD 9>>>
385 <COND (<==? <SET I <- .I 1>> 0> <RETURN>)>>
386 <COND (<L=? <SET NUM <- .NUM 1>> 0> <MAPLEAVE>)>>
389 <FUNCTION (C "AUX" (WRD <C-VALUE .C>))
390 #DECL ((C) CONST-REF (WRD) FIX)
391 <REPEAT ((I 4)) #DECL ((I) FIX)
392 <PRINTBYTE <SET WRD <ROT .WRD 9>>>
393 <COND (<==? <SET I <- .I 1>> 0> <RETURN>)>>>
395 <CHANNEL-OP .OC WRITE-BUFFER ,OUTPUT-BUFFER
396 <- ,OUTPUT-LENGTH <LENGTH .OB>>>
407 <DEFINE WRITE-MSUBR (G-I OC INM) #DECL ((G-I) GLUE-INFO)
409 <PRIN1 <MSUBR-NAME .G-I> .OC>
410 <PUTPROP <MSUBR-NAME .G-I> INFO>
411 <PRINC " #MSUBR [" .OC>
414 <PRIN1 <MSUBR-NAME .G-I> .OC>
416 <PRIN1 <MSUBR-DECL .G-I> .OC>
418 <PRIN1 <FINAL-LOC .G-I> .OC>
422 <DEFINE DO-ONE-GLUE (IMS MV MVP CURR CONST-S CV
423 "AUX" (COD <1 .IMS>) (REL-PC 0) (FRM-STACK ())
424 (GLUE-CALL-NO 0) (PC-DIFF 0)
425 (FRAME-CHANGES (T)) (FCP .FRAME-CHANGES)
426 (CV-LN <LENGTH .CV>) FUDGE (OUT-CNT <+ .CURR 1>))
427 #DECL ((IMS) IMSUBR (MV MVP FRM-STACK FCP FRAME-CHANGES) LIST
428 (CALLS) <VECTOR [REST ATOM]>
429 (CV-LN REL-PC OUT-CNT GLUE-CALL-NO CURR CONST-S) FIX
430 (COD) CODE (DB) <LIST [REST GLUE-INFO]> (CV) <UVECTOR [REST FIX]>)
432 <FUNCTION (IP "AUX" TMP (INS <1 .IP>) MOB (NARG <>) LD-NARG
433 LD-AT AC MI MA (INDX <GETBITS .INS ,INDX-BP>))
434 #DECL ((MI MA AC INS INDX LD-AT LD-NARG) FIX
435 (NARG) <OR FALSE FIX>)
436 <COND (<==? .INS ,JSP-FRAME>
437 <SET FRM-STACK (<+ .REL-PC 1> !.FRM-STACK)>)
438 (<==? .INS ,JSP-SFRAME>
439 <SET FRM-STACK (-1 !.FRM-STACK)>)
440 (<==? .INS ,JSP-CALL>
441 <COND (<EMPTY? .FRM-STACK>
442 <ERROR BAD-CODE-UNMATCHED-FRAME-CALL!-ERRORS>)
443 (<==? <1 .FRM-STACK> -1>
444 <SET FRM-STACK <REST .FRM-STACK>>)
446 <REPEAT ((N <- <LENGTH .COD> <LENGTH .IP>>) I AC)
449 <GETBITS <SET I <NTH .COD .N>>
454 <+ </ <ANDB .I *777777*>
459 <==? <GETBITS .I ,INS-BP> ,MOVEI>>
461 <SET NARG <ANDB .I *777777*>>)
462 (<==? .AC ,O2> <SET LD-NARG .N>)>
463 <COND (<L=? <SET N <- .N 1>> 0>
465 BAD-CODE-NO-LOAD-OF-MSUBR!-ERRORS>)>>
466 <COND (<AND <GASSIGNED? .MOB>
470 <GLUED-CALL-OK? .MOB>
488 "Wrong number args to "
489 <SPNAME <MSUBR-NAME .MOB>>
498 " not glued!"> ,OUTCHAN>
502 <+ .GLUE-CALL-NO ,GLUE-CALL-INS>>
504 <+ .GLUE-CALL-NO ,GLUE-LOAD-MS-INS>>
505 <PUT .COD <CHTYPE <1 .FRM-STACK> FIX>
506 <+ .GLUE-CALL-NO ,GLUE-FRM-INS>>
513 <COND (<AND .NARG <==? .MI .MA>>
517 <SET GLUE-CALL-NO <+ .GLUE-CALL-NO 4>>)>
518 <SET FRM-STACK <REST .FRM-STACK>>)>)
519 (<MEMQ .INS ,FUNNY-CALLS>
520 <SET FRM-STACK <REST .FRM-STACK>>)>
521 <COND (<G=? <SET REL-PC <+ .REL-PC 1>> .CONST-S>
525 <SET FCP <REST .FRAME-CHANGES>>
527 <FUNCTION (IP "AUX" TMP (INS <1 .IP>) MOB
528 CCOD (INDX <GETBITS .INS ,INDX-BP>))
529 #DECL ((CCOD INS INDX) FIX)
530 <COND (<L=? <ABS .INS> *777777*>
531 <COND (<==? <SET CCOD <ANDB .INS 3>> ,GLUE-FRM-INS>
532 <UPDATE-JUMPS <+ .REL-PC .PC-DIFF> .COD 4>
533 <SET PC-DIFF <+ .PC-DIFF 4>>)
534 (<==? .CCOD ,GLUE-LOAD-MS-INS> <SET FUDGE <>>)
535 (<==? .CCOD ,GLUE-LOAD-ARG> <SET FUDGE T>)
537 <N==? <GETBITS <SET INS <2 .FCP>> ,INS-BP>
539 <UPDATE-JUMPS <+ .REL-PC .PC-DIFF> .COD
540 <COND (.FUDGE -1) (ELSE 2)>>
541 <SET PC-DIFF <+ .PC-DIFF
542 <COND (.FUDGE -1) (ELSE 2)>>>)>
543 <COND (<==? .CCOD ,GLUE-CALL-INS>
544 <SET FCP <REST .FCP 3>>)>)
546 <SET MOB <NTH .IMS <+ </ <ANDB .INS *777777*> 2> 1>>>
547 <COND (<SET TMP <MEMBER .MOB <REST .MV>>>)
549 <PUTREST .MVP <SET TMP (.MOB)>>
551 <SET INS <PUTBITS .INS ,ADDR-BP
552 <+ <* <- <LENGTH .MV>
557 <COND (<G=? <SET REL-PC <+ .REL-PC 1>> .CONST-S>
561 <SET FCP <REST .FRAME-CHANGES>>
563 <FUNCTION (IP "AUX" (INS <1 .IP>) TMP MOB CCOD G-I FL
564 (INDX <GETBITS .INS ,INDX-BP>))
565 #DECL ((CCOD INS INDX) FIX (G-I) GLUE-INFO (FL) <OR FALSE FIX>)
566 <COND (<L? <- .CV-LN .OUT-CNT> 5>
567 <ERROR OUTPUT-CODE-VECTOR-OVERFLOW!-ERRORS>)>
568 <COND (<G? <SET REL-PC <+ .REL-PC 1>> .CONST-S>
569 <PUT .CV .OUT-CNT .INS>)
570 (<L=? <ABS .INS> *777777*>
571 <COND (<==? <SET CCOD <ANDB .INS 3>> ,GLUE-FRM-INS>
572 <PUT .CV .OUT-CNT ,SKIPL-T-1-PARENF>
573 <PUT .CV <SET OUT-CNT <+ .OUT-CNT 1>> ,HRROI-T>
574 <PUT .CV <SET OUT-CNT <+ .OUT-CNT 1>> ,PUSH-TP-T>
575 <PUT .CV <SET OUT-CNT <+ .OUT-CNT 1>>
578 <PUT .CV <SET OUT-CNT <+ .OUT-CNT 1>> ,PUSH-TP-F>)
579 (<==? .CCOD ,GLUE-CALL-INS>
580 <COND (<N==? <GETBITS <SET INS <2 .FCP>> ,INS-BP>
582 <PUT .CV .OUT-CNT ,XMOVEI-F-1-TP>
583 <PUT .CV <SET OUT-CNT <+ .OUT-CNT 1>>
585 <PUT .CV <SET OUT-CNT <+ .OUT-CNT 1>>
590 <ANDB <- <+ <* <ANDB .INS
594 <SET OUT-CNT <+ .OUT-CNT 1>>
595 <COND (<SET FL <FINAL-LOC <SET G-I <1 .FCP>>>>
596 <PUT .CV .OUT-CNT <ORB ,JRST-R .FL>>)
598 <PUT .CV .OUT-CNT ,JRST-R>
599 <REFS .G-I (.OUT-CNT !<REFS .G-I>)>)>
600 <ADD-CONST <ORB ,SETZ-R .OUT-CNT>
602 <SET FCP <REST .FCP 3>>)
603 (ELSE <SET OUT-CNT <- .OUT-CNT 1>>)>)
607 <ORB <ANDB .INS *777777000000*>
608 <ANDB <+ .INS .CURR> *777777*>>>)
609 (ELSE <PUT .CV .OUT-CNT .INS>)>
610 <SET OUT-CNT <+ .OUT-CNT 1>>>
614 <DEFINE ADD-CONST (X WHERE) #DECL ((X) FIX)
616 <FUNCTION (C-R) #DECL ((C-R) CONST-REF)
617 <COND (<==? <C-VALUE .C-R> .X>
618 <C-REFS .C-R (.WHERE !<C-REFS .C-R>)>
623 <SETG CONST-PTR (<CHTYPE [.X (.WHERE)] CONST-REF>)>>)>>
626 <DEFINE UPDATE-JUMPS (WHERE COD HOW-MUCH)
627 #DECL ((COD) CODE (WHERE HOW-MUCH) FIX)
629 <FUNCTION (IP "AUX" AD (INS <1 .IP>)
630 (INDX <GETBITS .INS ,INDX-BP>))
631 #DECL ((AD INS INDX) FIX)
632 <COND (<AND <==? .INDX ,R>
633 <G? <SET AD <ANDB .INS *777777*>> .WHERE>
637 <ORB <ANDB .INS *777777000000*>
638 <ANDB <+ .AD .HOW-MUCH> *777777*>>>)>>
641 <DEFINE ARG-SPEC (DCL "AUX" (MIN 0) (MAX 0) (OPT <>))
642 #DECL ((DCL) LIST (MIN MAX) FIX)
643 <COND (<OR <EMPTY? .DCL> <N=? <1 .DCL> "VALUE">>
648 <COND (<TYPE? .EL ATOM FORM SEGMENT>
651 <SET MIN <+ .MIN 1>>)>)
652 (<MEMBER .EL '["OPT" "OPTIONAL" "ARGS"]>
658 (ELSE <ERROR BAD-DECL!-ERRORS>)>>
660 <ORB <LSH .MAX 18> .MIN>)>>
662 <DEFINE GET-NM1 (STR "AUX" (SEEN-OP <>)) #DECL ((STR) STRING)
663 <MAPF ,STRING <FUNCTION (CH) <COND (<==? .CH !\<> <SET SEEN-OP T>)
664 (<==? .CH !\>> <SET SEEN-OP <>>)
666 <==? .CH !\.>> <MAPSTOP>)