4 <ENTRY NOT-ANA TYPE?-ANA ==?-ANA VALID-TYPE?-ANA TYPE-C-ANA =?-ANA S=?-ANA STRCOMP-ANA SUBSTRUC-ANA ATOM-PART-ANA OFFSET-PART-ANA PUT-GET-DECL-ANA>
6 <USE "SYMANA" "CHKDCL" "COMPDEC" "CARANA" "ADVMESS" "NPRINT">
8 " This module contains analysis and generation functions for
9 NOT, TYPE? and ==?. See SYMANA for more details about ANALYSIS and
10 CODGEN for more detali abour code generation.
13 "Analyze NOT usage make sure arg can be FALSE."
16 <GFCN
\1aNOT-ANA ("VALUE" ANY NODE ANY) NOD4 RTYP5>
17 <TEMP TEMP11 TEMP14 STR8 SUNT9:LIST TEM6>
19 <GEN-LVAL 'PRED = TEMP11>
20 <NTHUV NOD4 2 = TEMP14>
21 <EQUAL? TEMP11 TEMP14 - TAG10>
23 <SET TEMP11 'T (TYPE ATOM)>
26 <SET TEMP11 %<> (TYPE FALSE)>
28 <GEN-LVAL 'TRUTH = STR8>
29 <GEN-LVAL 'UNTRUTH = SUNT9>
30 <GETS 'BIND = TEMP14 (TYPE LBIND)>
31 <VEQUAL? TEMP11 0 + BOOL23>
34 <BBIND 'PRED 'ANY 'FIX TEMP11>
36 <BBIND 'TRUTH 'LIST 'FIX ()>
37 <BBIND 'UNTRUTH 'LIST 'FIX ()>
43 <CALL '
\1aSEGFLUSH 2 = TEM6>
44 <TYPE? TEM6 <TYPE-CODE FALSE> + PHRASE29>
45 <SET TEMP11 %<> (TYPE FALSE)>
49 <NTHUV NOD4 5 = TEMP11 (TYPE LIST)>
50 <LENL TEMP11 = STACK (TYPE FIX)>
56 <NTHUV NOD4 5 = TEMP11 (TYPE LIST)>
57 <NTHL TEMP11 1 = STACK (TYPE NODE)>
59 <CALL '
\1aANA 2 = TEM6>
60 <PUTUV NOD4 1 20 (TYPE FIX)>
63 <CALL '
\1aISTYPE? 1 = TEMP11>
64 <VEQUAL? TEMP11 'FALSE - PHRASE35>
68 <CALL '
\1aTYPE-OK? 2 = TEM6>
74 <CALL '
\1aTYPE-OK? 2 = TEMP11>
75 <TYPE? TEMP11 <TYPE-CODE FALSE> + PHRASE38>
79 <CALL '
\1aTYPE-OK? 2 = TEM6>
85 <CALL '
\1aTYPE-OK? 2 = TEM6>
87 <NTHR 'UNTRUTH 2 = TEMP11 (RECORD-TYPE ATOM) (TYPE LBIND)>
88 <NTHR TEMP11 1 = STR8 (RECORD-TYPE LBIND)>
89 <NTHR 'TRUTH 2 = TEMP11 (RECORD-TYPE ATOM) (TYPE LBIND)>
90 <NTHR TEMP11 1 = SUNT9 (RECORD-TYPE LBIND)>
95 <VEQUAL? TEMP11 0 + PHRASE48>
97 <SET TEMP11 0 (TYPE FIX)>
100 <LOOP (TEMP14 VALUE) (TEMP11 VALUE)>
103 <EMPL? TEMP14 + TAG49>
104 <NTHL TEMP14 1 = STACK>
105 <RESTL TEMP14 1 = TEMP14 (TYPE LIST)>
106 <ADD TEMP11 1 = TEMP11 (TYPE FIX)>
109 <GEN-LVAL 'TRUTH = TEMP14>
112 <VEQUAL? STR8 1 + TAG55>
114 <LOOP (TEMP14 TYPE VALUE LENGTH) (TEMP11 VALUE)>
117 <EMPTY? TEMP14 + TAG60>
118 <NTH1 TEMP14 = STACK>
119 <REST1 TEMP14 = TEMP14>
120 <ADD TEMP11 1 = TEMP11 (TYPE FIX)>
123 <LIST TEMP11 = TEMP14 (TYPE LIST)>
129 <VEQUAL? TEMP11 0 + TAG57>
131 <CONS STR8 TEMP14 = TEMP14 (TYPE LIST)>
133 <SUB TEMP11 1 = TEMP11 (TYPE FIX)>
136 <GEN-SET 'TRUTH TEMP14>
138 <SET TEMP14 0 (TYPE FIX)>
141 <LOOP (STR8 VALUE) (TEMP14 VALUE)>
145 <NTHL STR8 1 = STACK>
146 <RESTL STR8 1 = STR8 (TYPE LIST)>
147 <ADD TEMP14 1 = TEMP14 (TYPE FIX)>
150 <GEN-LVAL 'UNTRUTH = STR8>
152 <AND TEMP11 7 = TEMP11>
153 <VEQUAL? TEMP11 1 + TAG71>
155 <LOOP (STR8 TYPE VALUE LENGTH) (TEMP14 VALUE)>
158 <EMPTY? STR8 + TAG76>
161 <ADD TEMP14 1 = TEMP14 (TYPE FIX)>
164 <LIST TEMP14 = STR8 (TYPE LIST)>
170 <VEQUAL? TEMP14 0 + TAG73>
172 <CONS TEMP11 STR8 = STR8 (TYPE LIST)>
174 <SUB TEMP14 1 = TEMP14 (TYPE FIX)>
177 <GEN-SET 'UNTRUTH STR8>
183 " Analyze N==? and ==? usage. Complain if types differ such that
184 the args can never be ==?."
187 <GFCN
\1a==?-ANA ("VALUE" ANY NODE ANY) NOD4 RTYP5>
188 <TEMP K6:LIST TEMP3:LBIND TEMP16 TEMP19 KT9:LIST>
190 <NTHUV NOD4 5 = K6 (TYPE LIST)>
191 <GETS 'BIND = TEMP3 (TYPE LBIND)>
192 <GEN-LVAL 'PRED = TEMP16>
193 <NTHUV NOD4 2 = TEMP19>
194 <EQUAL? TEMP16 TEMP19 + TAG15>
196 <SET TEMP16 %<> (TYPE FALSE)>
201 <BBIND 'WHON 'NODE 'FIX TEMP16>
203 <BBIND 'WHO 'LIST 'FIX ()>
204 <BBIND 'GLN 'NODE 'FIX NOD4>
205 <BBIND 'GLE 'LIST 'FIX ()>
209 <CALL '
\1aSEGFLUSH 2 = TEMP16>
210 <TYPE? TEMP16 <TYPE-CODE FALSE> - PHRASE53>
211 <EMPL? K6 + PHRASE24>
212 <RESTL K6 1 = TEMP19 (TYPE LIST)>
213 <EMPL? TEMP19 - PHRASE24>
215 <NTHUV NOD4 5 = TEMP19 (TYPE LIST)>
216 <NTHL TEMP19 1 = TEMP16 (TYPE NODE)>
218 <NTHUV TEMP16 1 = TEMP19 (TYPE FIX)>
219 <VEQUAL? TEMP19 6 - PHRASE24 (TYPE FIX)>
221 <NTHUV TEMP16 4 = TEMP19>
222 <EQUAL? TEMP19 'LENGTH - PHRASE24>
224 <NTHUV TEMP16 5 = KT9 (TYPE LIST)>
226 <EMPL? KT9 + PHRASE24>
227 <RESTL KT9 1 = TEMP19 (TYPE LIST)>
228 <EMPL? TEMP19 + PHRASE24>
229 <RESTL TEMP19 1 = TEMP19 (TYPE LIST)>
230 <EMPL? TEMP19 - PHRASE24>
232 <FRAME '
\1aCOMPILE-WARNING>
233 <PUSH "Attempting to repair probable erroneous code:
238 <CALL '
\1aCOMPILE-WARNING 3>
239 <RESTL KT9 1 = TEMP16 (TYPE LIST)>
243 <NTHL KT9 1 = TEMP16 (TYPE NODE)>
245 <PUTUV TEMP16 2 NOD4>
247 <FRAME '
\1aNODE-COMPLAIN>
249 <CALL '
\1aNODE-COMPLAIN 1>
251 <GEN-LVAL 'OUTCHAN = STACK>
256 <LENL K6 = STACK (TYPE FIX)>
261 <NTHL K6 1 = STACK (TYPE NODE)>
265 <RESTL K6 1 = TEMP16 (TYPE LIST)>
266 <NTHL TEMP16 1 = STACK (TYPE NODE)>
270 <NTHL K6 1 = TEMP16 (TYPE NODE)>
271 <NTHUV TEMP16 1 = TEMP16 (TYPE FIX)>
272 <VEQUAL? TEMP16 2 - PHRASE38 (TYPE FIX)>
274 <RESTL K6 1 = TEMP16 (TYPE LIST)>
275 <NTHL TEMP16 1 = TEMP16 (TYPE NODE)>
276 <NTHUV TEMP16 1 = TEMP16 (TYPE FIX)>
277 <VEQUAL? TEMP16 2 - PHRASE38 (TYPE FIX)>
279 <NTHUV NOD4 4 = TEMP16>
280 <EQUAL? TEMP16 '==? - PHRASE41>
282 <NTHL K6 1 = TEMP16 (TYPE NODE)>
283 <NTHUV TEMP16 4 = TEMP16>
284 <RESTL K6 1 = TEMP19 (TYPE LIST)>
286 <NTHL TEMP19 1 = TEMP19 (TYPE NODE)>
287 <NTHUV TEMP19 4 = TEMP19>
288 <EQUAL? TEMP16 TEMP19 - TAG42>
290 <SET TEMP19 'T (TYPE ATOM)>
293 <SET TEMP19 %<> (TYPE FALSE)>
295 <PUTUV NOD4 4 TEMP19>
299 <NTHL K6 1 = TEMP19 (TYPE NODE)>
300 <NTHUV TEMP19 4 = TEMP19>
301 <RESTL K6 1 = TEMP16 (TYPE LIST)>
303 <NTHL TEMP16 1 = TEMP16 (TYPE NODE)>
304 <NTHUV TEMP16 4 = TEMP16>
305 <EQUAL? TEMP19 TEMP16 + TAG46>
307 <SET TEMP16 'T (TYPE ATOM)>
310 <SET TEMP16 %<> (TYPE FALSE)>
312 <PUTUV NOD4 4 TEMP16>
315 <PUTUV NOD4 5 () (TYPE LIST)>
316 <PUTUV NOD4 1 2 (TYPE FIX)>
317 <NTHUV NOD4 4 = TEMP16>
319 <VEQUAL? TEMP16 0 + PHRASE49>
325 <CALL '
\1aTYPE-OK? 2 = TEMP16>
332 <CALL '
\1aTYPE-OK? 2 = TEMP16>
335 <PUTUV NOD4 1 23 (TYPE FIX)>
337 <NTHL K6 1 = TEMP16 (TYPE NODE)>
338 <NTHUV TEMP16 3 = STACK>
340 <CALL '
\1aISTYPE? 1 = TEMP16>
341 <VEQUAL? TEMP16 'FIX - PHRASE55>
344 <RESTL K6 1 = TEMP16 (TYPE LIST)>
345 <NTHL TEMP16 1 = TEMP16 (TYPE NODE)>
346 <NTHUV TEMP16 3 = STACK>
348 <CALL '
\1aISTYPE? 1 = TEMP16>
349 <VEQUAL? TEMP16 'FIX - PHRASE55>
351 <PUTUV NOD4 1 22 (TYPE FIX)>
352 <FRAME '
\1aHACK-BOUNDS>
353 <NTHR 'WHO 2 = TEMP16 (RECORD-TYPE ATOM) (TYPE LBIND)>
354 <NTHR TEMP16 1 = STACK (RECORD-TYPE LBIND)>
356 <NTHR 'GLE 2 = TEMP16 (RECORD-TYPE ATOM) (TYPE LBIND)>
357 <NTHR TEMP16 1 = STACK (RECORD-TYPE LBIND)>
363 <CALL '
\1aHACK-BOUNDS 4>
369 <CALL '
\1aTYPE-OK? 2 = TEMP16>
377 " Ananlyze TYPE? usage warn about any potential losers by using
381 <GFCN
\1aTYPE?-ANA ("VALUE" ANY NODE ANY) NOD4 RTYP5>
382 <TEMP K6 LN7 (ALLGOOD9 'T) TEMP3:LBIND (FTYP11:LIST ()) (FNOK12 %<>) TEMP18 TEMP21 FLG78 TEMP83>
384 <NTHUV NOD4 5 = K6 (TYPE LIST)>
385 <LENL K6 = LN7 (TYPE FIX)>
386 <GETS 'BIND = TEMP3 (TYPE LBIND)>
387 <BBIND 'WHO 'LIST 'FIX ()>
388 <GEN-LVAL 'PRED = TEMP18>
389 <NTHUV NOD4 2 = TEMP21>
390 <EQUAL? TEMP18 TEMP21 + TAG17>
392 <SET TEMP18 %<> (TYPE FALSE)>
397 <BBIND 'WHON <OR NODE FALSE> 'FIX TEMP18>
402 <CALL '
\1aSEGFLUSH 2 = TEMP18>
403 <TYPE? TEMP18 <TYPE-CODE FALSE> + PHRASE23>
408 <PUSH <OR ATOM FALSE>>
409 <CALL '
\1aTYPE-OK? 2 = TEMP18>
412 <LESS? LN7 2 - PHRASE28 (TYPE FIX)>
414 <FRAME '
\1aCOMPILE-ERROR>
415 <PUSH "Too few arguments to TYPE? ">
417 <CALL '
\1aCOMPILE-ERROR 2>
420 <NTHL K6 1 = STACK (TYPE NODE)>
423 <CALL '
\1aEANA 3 = TEMP18>
424 <RESTL K6 1 = TEMP21 (TYPE LIST)>
429 <EMPL? TEMP21 + MAPAP35>
436 <NTHUV K6 1 = LN7 (TYPE FIX)>
437 <VEQUAL? LN7 2 + PHRASE48 (TYPE FIX)>
439 <SET ALLGOOD9 %<> (TYPE FALSE)>
444 <CALL '
\1aISTYPE? 1 = LN7>
445 <TYPE? LN7 <TYPE-CODE FALSE> - PHRASE51>
447 <FRAME '
\1aCOMPILE-ERROR>
448 <PUSH "Argument to TYPE? not a type ">
450 <CALL '
\1aCOMPILE-ERROR 2>
455 <CALL '
\1aTYPE-OK? 2 = LN7>
456 <TYPE? LN7 <TYPE-CODE FALSE> + BOOL54>
460 <CONS LN7 FTYP11 = FTYP11>
463 <RESTL TEMP21 1 = TEMP21 (TYPE LIST)>
466 <VEQUAL? ALLGOOD9 0 + PHRASE57>
467 <EMPL? FTYP11 + PHRASE57 (TYPE LIST)>
468 <RESTL FTYP11 1 = TEMP21 (TYPE LIST)>
469 <EMPL? TEMP21 - PHRASE60 (TYPE LIST)>
471 <NTHL FTYP11 1 = LN7>
474 <CONS 'OR FTYP11 = TEMP21>
475 <CHTYPE TEMP21 <TYPE-CODE FORM> = LN7>
478 <PUTUV NOD4 1 24 (TYPE FIX)>
484 <CALL '
\1aFORM 2 = STACK>
487 <CALL '
\1aTYPE-OK? 2 = TEMP21>
488 <TYPE? TEMP21 <TYPE-CODE FALSE> - TAG62>
490 <SET FNOK12 'T (TYPE ATOM)>
493 <SET FNOK12 %<> (TYPE FALSE)>
495 <NTHR 'WHO 2 = TEMP21 (RECORD-TYPE ATOM) (TYPE LBIND)>
496 <NTHR TEMP21 1 = TEMP18 (RECORD-TYPE LBIND)>
501 <EMPL? TEMP18 + PHRASE95>
504 <RESTL K6 1 = TEMP21 (TYPE LIST)>
505 <NTHL TEMP21 1 = TEMP21 (TYPE SYMTAB)>
506 <FRAME '
\1aADD-TYPE-LIST>
509 <GEN-LVAL 'TRUTH = STACK>
511 <RESTL K6 1 = TEMP83 (TYPE LIST)>
512 <RESTL TEMP83 1 = STACK (TYPE LIST)>
514 <CALL '
\1aADD-TYPE-LIST 5 = TEMP83>
515 <GEN-SET 'TRUTH TEMP83>
517 <VEQUAL? FNOK12 0 - BOOL86>
518 <FRAME '
\1aADD-TYPE-LIST>
524 <CALL '
\1aFORM 2 = STACK>
525 <GEN-LVAL 'UNTRUTH = STACK>
528 <RESTL K6 1 = K6 (TYPE LIST)>
529 <RESTL K6 1 = STACK (TYPE LIST)>
531 <CALL '
\1aADD-TYPE-LIST 5 = K6>
532 <GEN-SET 'UNTRUTH K6>
535 <RESTL TEMP18 1 = TEMP18 (TYPE LIST)>
538 <VEQUAL? ALLGOOD9 0 + PHRASE94>
539 <PUTUV NOD4 1 24 (TYPE FIX)>
543 <GEN-LVAL 'VERBOSE = TEMP18>
544 <TYPE? TEMP18 <TYPE-CODE FALSE> + BOOL96>
548 <CONS "Not open compiled." () = STACK>
549 <CALL '
\1aADDVMESS 2>
551 <PUTUV NOD4 1 52 (TYPE FIX)>
555 <VEQUAL? ALLGOOD9 0 - PHRASE102>
557 <SET TEMP18 <OR FALSE ATOM> (TYPE FORM)>
560 <EMPL? FTYP11 - PHRASE103 (TYPE LIST)>
562 <SET TEMP18 'FALSE (TYPE ATOM)>
565 <VEQUAL? FNOK12 0 + PHRASE104>
567 <SET TEMP18 'ATOM (TYPE ATOM)>
570 <SET TEMP18 <OR FALSE ATOM> (TYPE FORM)>
576 <CALL '
\1aTYPE-OK? 2 = TEMP18>
585 <GFCN
\1aVALID-TYPE?-ANA ("VALUE" ANY NODE ANY) N4 R5>
586 <TEMP K6:LIST LN7:FIX TEMP9>
588 <NTHUV N4 5 = K6 (TYPE LIST)>
589 <LENL K6 = LN7 (TYPE FIX)>
593 <CALL '
\1aSEGFLUSH 2 = TEMP9>
594 <TYPE? TEMP9 <TYPE-CODE FALSE> - PHRASE11>
603 <NTHL K6 1 = STACK (TYPE NODE)>
608 <PUTUV N4 1 97 (TYPE FIX)>
613 <PUSH <OR FALSE TYPE-C>>
614 <CALL '
\1aTYPE-OK? 2 = TEMP9>
618 <END
\1aVALID-TYPE?-ANA>
620 <GFCN
\1aTYPE-C-ANA ("VALUE" ANY NODE ANY) N4 R5>
621 <TEMP K6:LIST LN7:FIX TEMP9>
623 <NTHUV N4 5 = K6 (TYPE LIST)>
624 <LENL K6 = LN7 (TYPE FIX)>
628 <CALL '
\1aSEGFLUSH 2 = TEMP9>
629 <TYPE? TEMP9 <TYPE-CODE FALSE> - PHRASE11>
637 <NTHL K6 1 = STACK (TYPE NODE)>
641 <VEQUAL? LN7 2 - PHRASE15 (TYPE FIX)>
644 <RESTL K6 1 = K6 (TYPE LIST)>
645 <NTHL K6 1 = STACK (TYPE NODE)>
651 <PUTUV N4 1 96 (TYPE FIX)>
657 <CALL '
\1aTYPE-OK? 2 = TEMP9>
663 <GFCN
\1a=?-ANA ("VALUE" ANY NODE ANY) N4 R5>
664 <TEMP K6 LN7 TEMP13 N29:NODE>
666 <NTHUV N4 5 = K6 (TYPE LIST)>
667 <LENL K6 = LN7 (TYPE FIX)>
671 <CALL '
\1aSEGFLUSH 2 = TEMP13>
672 <TYPE? TEMP13 <TYPE-CODE FALSE> - PHRASE31>
681 <NTHL K6 1 = LN7 (TYPE NODE)>
687 <RESTL K6 1 = TEMP13 (TYPE LIST)>
688 <NTHL TEMP13 1 = N29 (TYPE NODE)>
694 <NTHUV LN7 1 = TEMP13 (TYPE FIX)>
695 <VEQUAL? TEMP13 2 - PHRASE21 (TYPE FIX)>
697 <RESTL K6 1 = TEMP13 (TYPE LIST)>
698 <NTHL TEMP13 1 = LN7 (TYPE NODE)>
700 <NTHL K6 1 = N29 (TYPE NODE)>
704 <NTHUV N29 3 = STACK>
706 <CALL '
\1aISTYPE? 1 = TEMP13>
708 <NTHUV LN7 3 = STACK>
710 <CALL '
\1aISTYPE? 1 = K6>
711 <VEQUAL? K6 'STRING + BOOL25>
712 <VEQUAL? TEMP13 'STRING - PHRASE24>
714 <PUTUV N4 1 95 (TYPE FIX)>
720 <CALL '
\1aTYPE-OK? 2 = TEMP13>
724 <TYPE? K6 <TYPE-CODE FALSE> + PHRASE28>
725 <TYPE? TEMP13 <TYPE-CODE FALSE> + PHRASE28>
726 <VEQUAL? K6 TEMP13 + PHRASE28>
732 <CALL '
\1aTYPE-OK? 2 = TEMP13>
740 <CALL '
\1aTYPE-OK? 2 = TEMP13>
746 <GFCN
\1aS=?-ANA ("VALUE" ANY NODE ANY) N4 R5>
749 <NTHUV N4 5 = K6 (TYPE LIST)>
753 <CALL '
\1aSEGFLUSH 2 = TEMP8>
754 <TYPE? TEMP8 <TYPE-CODE FALSE> - PHRASE10>
756 <LENL K6 = STACK (TYPE FIX)>
762 <NTHL K6 1 = STACK (TYPE NODE)>
767 <RESTL K6 1 = K6 (TYPE LIST)>
768 <NTHL K6 1 = STACK (TYPE NODE)>
773 <PUTUV N4 1 95 (TYPE FIX)>
779 <CALL '
\1aTYPE-OK? 2 = TEMP8>
785 <GFCN
\1aATOM-PART-ANA ("VALUE" ANY NODE ANY) N4 R5>
786 <TEMP K6 NM7:ATOM TEMP10 NN8:NODE>
788 <NTHUV N4 5 = K6 (TYPE LIST)>
789 <NTHUV N4 4 = NM7 (TYPE ATOM)>
793 <CALL '
\1aSEGFLUSH 2 = TEMP10>
794 <TYPE? TEMP10 <TYPE-CODE FALSE> - PHRASE30>
796 <LENL K6 = STACK (TYPE FIX)>
797 <VEQUAL? NM7 'GBIND + BOOL16>
798 <VEQUAL? NM7 'LBIND - PHRASE15>
800 <SET TEMP10 (1 2) (TYPE LIST)>
803 <SET TEMP10 1 (TYPE FIX)>
811 <NTHL K6 1 = STACK (TYPE NODE)>
815 <RESTL K6 1 = TEMP10 (TYPE LIST)>
816 <EMPL? TEMP10 + PHRASE21 (TYPE LIST)>
819 <RESTL K6 1 = TEMP10 (TYPE LIST)>
820 <NTHL TEMP10 1 = NN8 (TYPE NODE)>
827 <NTHL K6 1 = TEMP10 (TYPE NODE)>
828 <NTHUV TEMP10 1 = TEMP10 (TYPE FIX)>
829 <VEQUAL? TEMP10 2 - PHRASE24 (TYPE FIX)>
831 <VEQUAL? NM7 'LBIND + PHRASE24>
832 <VEQUAL? NM7 'GBIND + PHRASE24>
833 <PUTUV N4 1 2 (TYPE FIX)>
834 <PUTUV N4 5 () (TYPE LIST)>
838 <NTHL K6 1 = K6 (TYPE NODE)>
841 <ACALL TEMP10 1 = K6>
849 <CALL '
\1aTYPE 1 = STACK>
852 <CALL '
\1aTYPE-OK? 2 = TEMP10>
856 <VEQUAL? NM7 'GBIND + BOOL34>
857 <VEQUAL? NM7 'LBIND - BOOL33>
859 <RESTL K6 1 = K6 (TYPE LIST)>
860 <EMPL? K6 + BOOL33 (TYPE LIST)>
862 <NTHUV NN8 1 = K6 (TYPE FIX)>
863 <VEQUAL? K6 2 - PHRASE32 (TYPE FIX)>
867 <TYPE? K6 <TYPE-CODE FALSE> - PHRASE32>
870 <PUTUV N4 1 100 (TYPE FIX)>
876 <VEQUAL? NM7 'SPNAME - PHRASE38>
877 <SET K6 'STRING (TYPE ATOM)>
880 <VEQUAL? NM7 'OBLIST? - PHRASE39>
881 <SET K6 <OR FALSE OBLIST> (TYPE FORM)>
889 <CALL '
\1aTYPE-OK? 2 = TEMP10>
893 <END
\1aATOM-PART-ANA>
895 <GFCN
\1aPUT-GET-DECL-ANA ("VALUE" ANY NODE ANY) N4 R5>
896 <TEMP K6 NM7:ATOM TEMP10 ST8 TEMP25:FIX TEMP31>
898 <NTHUV N4 5 = K6 (TYPE LIST)>
899 <NTHUV N4 4 = NM7 (TYPE ATOM)>
903 <CALL '
\1aSEGFLUSH 2 = TEMP10>
904 <TYPE? TEMP10 <TYPE-CODE FALSE> - PHRASE40>
906 <LENL K6 = STACK (TYPE FIX)>
907 <VEQUAL? NM7 'PUT-DECL - PHRASE15>
908 <SET TEMP10 2 (TYPE FIX)>
911 <SET TEMP10 1 (TYPE FIX)>
919 <NTHL K6 1 = STACK (TYPE NODE)>
920 <PUSH <OR ATOM OFFSET GBIND LBIND>>
922 <CALL '
\1aEANA 3 = ST8>
923 <VEQUAL? NM7 'PUT-DECL - PHRASE20>
927 <CALL '
\1aTYPE-AND 2 = TEMP10>
928 <TYPE? TEMP10 <TYPE-CODE FALSE> - BOOL21>
935 <RESTL K6 1 = TEMP10 (TYPE LIST)>
936 <NTHL TEMP10 1 = STACK (TYPE NODE)>
938 <PUSH <OR ATOM FALSE FORM SEGMENT>>
942 <SET TEMP25 1 (TYPE FIX)>
943 <NTHUV N4 8 = TEMP10>
944 <TYPE TEMP10 = TEMP31>
945 <AND TEMP31 7 = TEMP31>
946 <VEQUAL? TEMP31 1 + TAG27>
948 <LOOP (TEMP10 TYPE VALUE LENGTH) (TEMP25 VALUE)>
951 <EMPTY? TEMP10 + TAG32>
952 <NTH1 TEMP10 = STACK>
953 <REST1 TEMP10 = TEMP10>
954 <ADD TEMP25 1 = TEMP25 (TYPE FIX)>
957 <LIST TEMP25 = TEMP10 (TYPE LIST)>
963 <VEQUAL? TEMP25 0 + TAG29>
965 <CONS TEMP31 TEMP10 = TEMP10 (TYPE LIST)>
967 <SUB TEMP25 1 = TEMP25 (TYPE FIX)>
973 <NTHL K6 1 = TEMP10 (TYPE NODE)>
974 <NTHUV TEMP10 1 = TEMP10 (TYPE FIX)>
975 <VEQUAL? TEMP10 2 - PHRASE35 (TYPE FIX)>
977 <VEQUAL? NM7 'GET-DECL - PHRASE35>
978 <PUTUV N4 1 2 (TYPE FIX)>
979 <PUTUV N4 5 () (TYPE LIST)>
981 <NTHL K6 1 = TEMP10 (TYPE NODE)>
983 <NTHUV TEMP10 4 = STACK>
985 <CALL '
\1aGET-DECL 1 = TEMP10>
992 <CALL '
\1aTYPE 1 = STACK>
995 <CALL '
\1aTYPE-OK? 2 = TEMP10>
1001 <CALL '
\1aISTYPE? 1 = TEMP10>
1002 <SET TEMP31 [LBIND GBIND OFFSET] (TYPE VECTOR)>
1003 <TYPE? TEMP10 <TYPE-CODE ATOM> - PHRASE42>
1004 <LOOP (TEMP10 VALUE) (TEMP31 LENGTH VALUE)>
1006 <NTHUV TEMP31 1 = K6>
1007 <VEQUAL? K6 TEMP10 + TAG43>
1009 <RESTUV TEMP31 1 = TEMP31 (TYPE VECTOR)>
1010 <EMPUV? TEMP31 - TAG44>
1013 <PUTUV N4 1 102 (TYPE FIX)>
1017 <GEN-LVAL 'VERBOSE = TEMP31>
1018 <TYPE? TEMP31 <TYPE-CODE FALSE> + PHRASE48>
1020 <FRAME '
\1aADDVMESS>
1023 <CONS ST8 () = TEMP31>
1024 <CONS "Not open compiled because type is " TEMP31 = TEMP31>
1025 <CONS NM7 TEMP31 = STACK>
1027 <CALL '
\1aADDVMESS 2>
1029 <FRAME '
\1aTYPE-OK?>
1030 <VEQUAL? NM7 'GET-DECL - PHRASE54>
1032 <SET TEMP31 <OR ATOM FALSE FORM SEGMENT> (TYPE FORM)>
1042 <CALL '
\1aTYPE-OK? 2 = TEMP10>
1046 <END
\1aPUT-GET-DECL-ANA>
1048 <GFCN
\1aOFFSET-PART-ANA ("VALUE" ANY NODE ANY) N4 R5>
1049 <TEMP K6 NM7:ATOM TEMP9>
1051 <NTHUV N4 5 = K6 (TYPE LIST)>
1052 <NTHUV N4 4 = NM7 (TYPE ATOM)>
1053 <FRAME '
\1aSEGFLUSH>
1056 <CALL '
\1aSEGFLUSH 2 = TEMP9>
1057 <TYPE? TEMP9 <TYPE-CODE FALSE> - PHRASE28>
1059 <LENL K6 = STACK (TYPE FIX)>
1060 <VEQUAL? NM7 'INDEX - PHRASE14>
1061 <SET TEMP9 1 (TYPE FIX)>
1064 <SET TEMP9 (1 2) (TYPE LIST)>
1072 <NTHL K6 1 = STACK (TYPE NODE)>
1076 <RESTL K6 1 = TEMP9 (TYPE LIST)>
1077 <EMPL? TEMP9 + PHRASE19 (TYPE LIST)>
1080 <RESTL K6 1 = TEMP9 (TYPE LIST)>
1081 <NTHL TEMP9 1 = STACK (TYPE NODE)>
1083 <PUSH <OR ATOM FALSE FORM SEGMENT>>
1087 <NTHL K6 1 = TEMP9 (TYPE NODE)>
1088 <NTHUV TEMP9 1 = TEMP9 (TYPE FIX)>
1089 <VEQUAL? TEMP9 2 - PHRASE22 (TYPE FIX)>
1091 <RESTL K6 1 = TEMP9 (TYPE LIST)>
1092 <EMPL? TEMP9 - PHRASE22 (TYPE LIST)>
1094 <PUTUV N4 1 2 (TYPE FIX)>
1095 <PUTUV N4 5 () (TYPE LIST)>
1099 <NTHL K6 1 = K6 (TYPE NODE)>
1100 <NTHUV K6 4 = STACK>
1102 <ACALL TEMP9 1 = K6>
1106 <FRAME '
\1aTYPE-OK?>
1108 <NTHUV N4 4 = STACK>
1110 <CALL '
\1aTYPE 1 = STACK>
1113 <CALL '
\1aTYPE-OK? 2 = TEMP9>
1117 <PUTUV N4 1 101 (TYPE FIX)>
1119 <FRAME '
\1aTYPE-OK?>
1122 <VEQUAL? NM7 'INDEX - PHRASE31>
1124 <SET K6 'FIX (TYPE ATOM)>
1127 <RESTL K6 1 = TEMP9 (TYPE LIST)>
1129 <EMPL? TEMP9 + PHRASE32 (TYPE LIST)>
1131 <SET K6 'OFFSET (TYPE ATOM)>
1134 <SET K6 <OR ATOM FALSE FORM SEGMENT> (TYPE FORM)>
1138 <CALL '
\1aTYPE-OK? 2 = TEMP9>
1142 <END
\1aOFFSET-PART-ANA>
1144 <GFCN
\1aSTRCOMP-ANA ("VALUE" ANY NODE ANY) N4 R5>
1145 <TEMP K6:LIST TEMP8>
1147 <NTHUV N4 5 = K6 (TYPE LIST)>
1148 <FRAME '
\1aSEGFLUSH>
1151 <CALL '
\1aSEGFLUSH 2 = TEMP8>
1152 <TYPE? TEMP8 <TYPE-CODE FALSE> - PHRASE10>
1154 <LENL K6 = STACK (TYPE FIX)>
1156 <NTHUV N4 4 = STACK>
1159 <FRAME '
\1aSTRCOMP-ARG-ANA>
1160 <NTHL K6 1 = STACK (TYPE NODE)>
1163 <CALL '
\1aSTRCOMP-ARG-ANA 3 = TEMP8>
1164 <TYPE? TEMP8 <TYPE-CODE FALSE> + PHRASE13>
1166 <FRAME '
\1aSTRCOMP-ARG-ANA>
1167 <RESTL K6 1 = TEMP8 (TYPE LIST)>
1169 <NTHL TEMP8 1 = STACK (TYPE NODE)>
1173 <CALL '
\1aSTRCOMP-ARG-ANA 3 = TEMP8>
1174 <TYPE? TEMP8 <TYPE-CODE FALSE> + PHRASE13>
1176 <PUTUV N4 1 95 (TYPE FIX)>
1179 <FRAME '
\1aTYPE-OK?>
1183 <CALL '
\1aTYPE-OK? 2 = TEMP8>
1187 <END
\1aSTRCOMP-ANA>
1190 <GFCN
\1aSTRCOMP-ARG-ANA ("VALUE" ANY NODE NODE FIX) N4 P5 IDX6>
1191 <TEMP TYP7 ITYP8 NN9:NODE>
1197 <CALL '
\1aEANA 3 = TYP7>
1200 <CALL '
\1aISTYPE? 1 = ITYP8>
1201 <TYPE? ITYP8 <TYPE-CODE FALSE> + PHRASE12>
1202 <VEQUAL? ITYP8 'ATOM - PHRASE19>
1204 <NTHUV N4 1 = TYP7 (TYPE FIX)>
1205 <VEQUAL? TYP7 2 - PHRASE17 (TYPE FIX)>
1207 <NTHUV N4 4 = TYP7 (TYPE ATOM)>
1208 <NTHR TYP7 3 = TYP7 (RECORD-TYPE ATOM)>
1211 <PUTUV N4 3 'STRING>
1220 <CONS N4 () = STACK>
1221 <GVAL 'SPNAME = STACK>
1222 <CALL '
\1aNODEFM 6 = NN9>
1223 <NTHUV P5 5 = TYP7 (TYPE LIST)>
1225 <GRTR? IDX6 0 - COMPERR (TYPE FIX)>
1228 <SUB ITYP8 1 = ITYP8 (TYPE FIX)>
1229 <GRTR? ITYP8 0 - RESTL23 (TYPE FIX)>
1230 <LOOP (TYP7 VALUE) (ITYP8 VALUE)>
1233 <EMPL? TYP7 + COMPERR>
1234 <RESTL TYP7 1 = TYP7 (TYPE LIST)>
1235 <SUB ITYP8 1 = ITYP8 (TYPE FIX)>
1236 <GRTR? ITYP8 0 + RESTL22 (TYPE FIX)>
1238 <EMPL? TYP7 + COMPERR>
1248 <PUSH <OR ATOM STRING>>
1249 <CALL '
\1a=? 2 = ITYP8>
1250 <VEQUAL? ITYP8 0 + PHRASE24>
1254 <FRAME '
\1aTYPE-OK?>
1257 <PUSH <OR ATOM STRING>>
1258 <CALL '
\1aTYPE-OK? 2 = ITYP8>
1259 <TYPE? ITYP8 <TYPE-CODE FALSE> - PHRASE26>
1261 <FRAME '
\1aCOMPILE-ERROR>
1262 <PUSH "Argument wrong type to: ">
1266 <CALL '
\1aCOMPILE-ERROR 3 = TYP7>
1271 <END
\1aSTRCOMP-ARG-ANA>
1274 <GFCN
\1aSUBSTRUC-ANA ("VALUE" ANY NODE ANY) N4 R5>
1275 <TEMP K6 LN7 TEMP10 TEMP20>
1277 <NTHUV N4 5 = K6 (TYPE LIST)>
1278 <LENL K6 = LN7 (TYPE FIX)>
1279 <FRAME '
\1aSEGFLUSH>
1282 <CALL '
\1aSEGFLUSH 2 = TEMP10>
1283 <TYPE? TEMP10 <TYPE-CODE FALSE> - PHRASE12>
1287 <NTHUV N4 4 = STACK>
1291 <NTHL K6 1 = STACK (TYPE NODE)>
1294 <CALL '
\1aEANA 3 = TEMP10>
1295 <GRTR? LN7 1 - PHRASE16 (TYPE FIX)>
1297 <RESTL K6 1 = TEMP20 (TYPE LIST)>
1298 <NTHL TEMP20 1 = STACK (TYPE NODE)>
1304 <GRTR? LN7 2 - PHRASE22 (TYPE FIX)>
1306 <RESTL K6 1 = TEMP20 (TYPE LIST)>
1307 <RESTL TEMP20 1 = TEMP20 (TYPE LIST)>
1308 <NTHL TEMP20 1 = STACK (TYPE NODE)>
1314 <GRTR? LN7 3 - PHRASE25 (TYPE FIX)>
1316 <FRAME '
\1aSTRUCTYP>
1319 <CALL '
\1aSTRUCTYP 1 = TEMP10>
1321 <RESTL K6 1 = TEMP20 (TYPE LIST)>
1323 <RESTL TEMP20 1 = TEMP20 (TYPE LIST)>
1324 <RESTL TEMP20 1 = TEMP20 (TYPE LIST)>
1325 <NTHL TEMP20 1 = STACK (TYPE NODE)>
1327 <TYPE? TEMP10 <TYPE-CODE FALSE> + PHRASE29>
1332 <CALL '
\1aFORM 2 = TEMP20>
1335 <SET TEMP20 'STRUCTURED (TYPE ATOM)>
1340 <CALL '
\1aEANA 3 = TEMP10>
1342 <SET LN7 1 (TYPE FIX)>
1343 <NTHUV N4 8 = TEMP20>
1346 <VEQUAL? K6 1 + TAG35>
1348 <LOOP (TEMP20 TYPE VALUE LENGTH) (LN7 VALUE)>
1351 <EMPTY? TEMP20 + TAG40>
1352 <NTH1 TEMP20 = STACK>
1353 <REST1 TEMP20 = TEMP20>
1354 <ADD LN7 1 = LN7 (TYPE FIX)>
1357 <LIST LN7 = TEMP20 (TYPE LIST)>
1363 <VEQUAL? LN7 0 + TAG37>
1365 <CONS K6 TEMP20 = TEMP20 (TYPE LIST)>
1367 <SUB LN7 1 = LN7 (TYPE FIX)>
1373 <FRAME '
\1aSTRUCTYP>
1375 <CALL '
\1aSTRUCTYP 1 = TEMP20>
1376 <SET K6 [STRING VECTOR UVECTOR BYTES] (TYPE VECTOR)>
1377 <TYPE? TEMP20 <TYPE-CODE ATOM> - PHRASE43>
1378 <LOOP (TEMP20 VALUE) (K6 LENGTH VALUE)>
1381 <VEQUAL? LN7 TEMP20 + TAG44>
1383 <RESTUV K6 1 = K6 (TYPE VECTOR)>
1387 <PUTUV N4 1 81 (TYPE FIX)>
1390 <FRAME '
\1aTYPE-OK?>
1391 <FRAME '
\1aSTRUCTYP>
1394 <CALL '
\1aSTRUCTYP 1 = STACK>
1397 <CALL '
\1aTYPE-OK? 2 = TEMP10>
1401 <END
\1aSUBSTRUC-ANA>
\r\r
1402 <COND (<AND <GASSIGNED? NOT-ANA> <GASSIGNED? ELEMENT-DECL>> <PUTPROP ,NOT ANALYSIS ,NOT-ANA> <PUTPROP ,==? ANALYSIS ,==?-ANA> <PUTPROP ,N==? ANALYSIS ,==?-ANA> <PUTPROP ,TYPE? ANALYSIS ,TYPE?-ANA> <PUTPROP ,=? ANALYSIS ,=?-ANA> <PUTPROP ,N=? ANALYSIS ,=?-ANA> <PUTPROP ,VALID-TYPE? ANALYSIS ,VALID-TYPE?-ANA> <PUTPROP ,TYPE-C ANALYSIS ,TYPE-C-ANA> <PUTPROP ,INDEX ANALYSIS ,OFFSET-PART-ANA> <PUTPROP ,ELEMENT-DECL ANALYSIS ,OFFSET-PART-ANA> <PUTPROP ,PUT-DECL ANALYSIS ,PUT-GET-DECL-ANA> <PUTPROP ,GET-DECL ANALYSIS ,PUT-GET-DECL-ANA> <PUTPROP ,SPNAME ANALYSIS ,ATOM-PART-ANA> <PUTPROP ,OBLIST? ANALYSIS ,ATOM-PART-ANA> <PUTPROP ,LBIND ANALYSIS ,ATOM-PART-ANA> <PUTPROP ,GBIND ANALYSIS ,ATOM-PART-ANA> <PUTPROP ,S=? ANALYSIS ,S=?-ANA> <PUTPROP ,STRCOMP ANALYSIS ,STRCOMP-ANA> <PUTPROP ,SUBSTRUC ANALYSIS ,SUBSTRUC-ANA>)>