28 " Generate NOT code. This is done in a variety of ways.
29 1) If NOTs arg is a predicate itself and this is a predicate usage
30 (flagged by BRANCH arg), just pass through setting the NOTF arg.
31 2) If NOTs arg is a predicate but a value is needed,
32 set up a predicate like situation and return NOT of the normal
34 3) Else just compile and complement result."
36 <DEFINE NOT-GEN (NOD WHERE
37 "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR T) (SETF <>)
38 "AUX" (P <1 <KIDS .NOD>>) (RW .WHERE)
39 (PF <PRED-CHECK? .P .DIR .WHERE>) T1 T2 TT (FLG <>))
41 <SET NOTF <NOT .NOTF>>
42 <COND (<AND .BRANCH .PF>
45 <COND (<==? .RW FLUSHED> FLUSHED)
51 (<AND .BRANCH <==? .RW FLUSHED>>
52 <AND .NOTF <SET DIR <NOT .DIR>>>
53 <SET WHERE <GEN .P DONT-CARE>>
54 <D-B-TAG .BRANCH .WHERE .DIR <RESULT-TYPE .P>>)
56 <SET TT <GEN .P DONT-CARE>>
58 <D-B-TAG .T1 .TT .DIR <RESULT-TYPE .P>>
60 <SET WHERE <MOVE-ARG <REFERENCE .DIR> .WHERE>>
64 <DEALLOCATE-TEMP <MOVE-ARG <REFERENCE <NOT .DIR>> .WHERE>>)>)
65 (<==? .RW FLUSHED> <SET WHERE <GEN .P FLUSHED>>)
66 (<OR <SET FLG <==? <ISTYPE? <RESULT-TYPE .NOD>> FALSE>>
67 <NOT <TYPE-OK? <RESULT-TYPE .NOD> FALSE>>>
69 <SET WHERE <MOVE-ARG <REFERENCE <NOT .FLG>> .WHERE>>)
73 <PGEN-DISPATCH .P FLUSHED .NOTF .T1 .DIR .SETF>
74 <COND (<NOT <TYPE? .WHERE TEMP>> <SET WHERE <GEN-TEMP <>>>)>
75 <MOVE-ARG <REFERENCE <>> .WHERE>
78 <DEALLOCATE-TEMP .WHERE>
79 <MOVE-ARG <REFERENCE T> .WHERE>
84 <SET TT <GEN .P DONT-CARE>>
85 <D-B-TAG .T1 .TT T <RESULT-TYPE .P>>
87 <COND (<NOT <TYPE? .WHERE TEMP>> <SET WHERE <GEN-TEMP <>>>)>
88 <MOVE-ARG <REFERENCE T> .WHERE>
91 <DEALLOCATE-TEMP .WHERE>
92 <MOVE-ARG <REFERENCE <>> .WHERE>
94 <MOVE-ARG .WHERE .RW>>
96 <DEFINE PRED? (N) #DECL ((N) FIX) <N==? <NTH ,PREDV .N> 0>>
98 <DEFINE PRED-CHECK? (N TF W "AUX" SY K NN NT)
99 #DECL ((N) NODE (SY) SYMTAB)
101 <N==? <NTH ,PREDV <NODE-TYPE .N>> 0>
102 <AND <==? <SET NT <NODE-TYPE .N>> ,CALL-CODE>
103 <G=? <LENGTH <SET K <KIDS .N>>> 2>
104 <OR <AND <OR .TF <==? .W FLUSHED>> <==? <NODE-NAME <1 .K>> `SYSOP>>
105 <=? <SPNAME <NODE-NAME <1 .K>>> "STRING-EQUAL?">>>
106 <AND <==? .NT ,SET-CODE>
108 <NOT <SPEC-SYM <SET SY <NODE-NAME .N>>>>
109 <==? <NTH ,PREDV <NODE-TYPE <2 <KIDS .N>>>> 1>>
113 <AND <==? .NT ,MAP-CODE>
114 <==? <NODE-TYPE <SET NN <1 <SET K <KIDS .N>>>>> ,QUOTE-CODE>
115 <NOT <NODE-NAME .NN>>
116 <==? <NODE-TYPE <SET N <2 .K>>> ,MFCN-CODE>
117 <OR <==? <ISTYPE? <SET NT <RESULT-TYPE .N>>> FALSE>
118 <NOT <TYPE-AND .NT FALSE>>>
121 <COND (<OR <==? <SET NT <NODE-TYPE .X>> ,SEGMENT-CODE>
126 <NOT <ACTIV? <BINDING-STRUCTURE .N>>>
130 <FUNCTION (SYM:SYMTAB "AUX" NN)
131 <COND (<OR <SPEC-SYM .SYM>
132 <AND <SET NN <INIT-SYM .SYM>>
133 <OR <==? <SET NT <NODE-TYPE .NN>> ,STACK-CODE>
134 <AND <==? .NT ,COPY-CODE>
135 <==? <NODE-NAME .NN> TUPLE>>
136 <AND <OR <==? .NT ,ISTRUC-CODE>
137 <==? .NT ,ISTRUC2-CODE>>
138 <==? <NODE-NAME .NN> ITUPLE>>>>>
140 <BINDING-STRUCTURE .N>>>>>>
142 " Generate code for ==?. If types are the same then just compare values,
143 otherwise generate a full comparison."
145 <DEFINE ==-GEN (NOD WHERE
146 "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>) (SETF <>)
147 "AUX" (K <KIDS .NOD>) REG REG2 B2 T2OK T2 T1
148 (TY1 <RESULT-TYPE <1 .K>>) (TY2 <RESULT-TYPE <2 .K>>)
149 (T1OK <ISTYPE? .TY1>)
152 <OR <==? .T1OK <SET T2OK <ISTYPE? .TY2>>>
153 <==? <GETPROP .T1OK ALT-DECL '.T1OK>
154 <GETPROP .T2OK ALT-DECL '.T2OK>>>
155 .T1OK>) (RW .WHERE) (SDIR .DIR) (FLS <==? .RW FLUSHED>)
157 #DECL ((NOD) NODE (K) <LIST [REST NODE]>)
158 <COND (<AND <NOT .TYPSAM>
159 <NOT <TYPE-OK? .TY1 '<PRIMTYPE FIX>>>
160 <NOT <TYPE-OK? .TY2 '<PRIMTYPE FIX>>>
161 <NOT <POINTER-OVERLAP? .TY1 .TY2>>>
163 <COND (<==? <NODE-SUBR .NOD> ,N==?> <SET NOTF <NOT .NOTF>>)>
165 <NOT <TYPE-OK? .TY1 .TY2>>
166 <COMPILE-WARNING "Arguments can never be ==? "
169 <COND (<OR <==? <NODE-TYPE <SET T1 <1 .K>>> ,QUOTE-CODE>
170 <AND <NOT <SIDE-EFFECTS .NOD>>
171 <N==? <NODE-TYPE <SET T2 <2 .K>>> ,QUOTE-CODE>
172 <MEMQ <NODE-TYPE .T1> ,SNODES>
173 <N==? <NODE-TYPE .T2> ,LVAL-CODE>>>
180 <AND .NOTF <SET DIR <NOT .DIR>>>
182 <DEALLOCATE-TEMP <MOVE-ARG <REFERENCE <NOT .SDIR>> .WHERE>>)>
187 <COND (.FLS .DIR) (ELSE <NOT .DIR>)>
189 <COND (.FLS .BRANCH) (ELSE <SET B2 <MAKE-TAG>>)>>
192 <MOVE-ARG <MOVE-ARG <REFERENCE .SDIR> .WHERE> .RW>>
197 <SET BRANCH <MAKE-TAG>>
198 <GEN-EQTST <1 .K> <2 .K> .T1OK .T2OK .NOTF .TYPSAM .BRANCH>
199 <COND (<==? .WHERE DONT-CARE> <SET WHERE <GEN-TEMP <>>>)>
200 <MOVE-ARG <REFERENCE T> .WHERE>
201 <DEALLOCATE-TEMP .WHERE>
202 <BRANCH-TAG <SET B2 <MAKE-TAG>>>
204 <MOVE-ARG <REFERENCE <>> .WHERE>
206 <MOVE-ARG .WHERE .RW>)>>
208 <DEFINE GEN-EQTST (N1 N2 T1 T2 DIR TYPS BR "AUX" (TMP <>) R1 R2)
212 <COND (.TYPS <GEN-VAL-==? .R1 .R2 .DIR .BR>)
213 (ELSE <GEN-==? .R1 .R2 .DIR .BR>)>
217 <DEFINE POINTER-OVERLAP? (TY1 TY2 "AUX" TEM)
218 <COND (<AND <TYPE? .TY1 FORM SEGMENT>
223 <COND (<POINTER-OVERLAP? .TY2 .EL>
226 (<AND <TYPE? .TY2 FORM SEGMENT>
231 <COND (<POINTER-OVERLAP? .TY1 .EL>
234 (<OR <AND <TYPE? .TY1 FORM SEGMENT> <NOT <EMPTY? .TY1>>>
235 <AND <TYPE? .TY2 FORM SEGMENT>
240 <COND (<OR <==? <1 .TY1> PRIMTYPE>
241 <AND <TYPE? <SET TEM <1 .TY1>> FORM SEGMENT>
243 <==? <1 .TEM> PRIMTYPE>
245 <COND (<==? <STRUCTYP .TY2> <2 .TY1>> T)
248 <POINTER-OVERLAP? <1 .TY1> .TY2>)>)
250 (<OR <NOT <STRUCTYP .TY1>>
251 <NOT <STRUCTYP .TY2>>
252 <==? <STRUCTYP .TY1> <STRUCTYP .TY2>>>
257 " Generate TYPE? code for all various cases."
259 <DEFINE TYPE?-GEN (NOD WHERE
260 "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>) (SETF <>)
261 "AUX" B2 REG (RW .WHERE) (K <KIDS .NOD>) (SDIR .DIR)
262 (FLS <==? .RW FLUSHED>) B3 (TEST? T) (FIRST T))
263 #DECL ((NOD) NODE (K) <LIST [REST NODE]> (WHERE BRANCH B2 B3) ANY)
264 <COND (<==? <RESULT-TYPE .NOD> FALSE>
265 <COMPILE-WARNING "TYPE? never true: " .NOD>
266 <SET TEST? #FALSE (1)>)
267 (<NOT <TYPE-OK? <RESULT-TYPE .NOD> FALSE>>
268 <COMPILE-WARNING "TYPE? always true: " .NOD>
269 <SET TEST? #FALSE (2)>)>
270 <SET REG <GEN <1 .K> DONT-CARE>>
271 <AND .NOTF <SET DIR <NOT .DIR>>>
275 <AND <NOT <EMPTY? <REST .K>>> <NOT .DIR> <SET B2 <MAKE-TAG>>>
280 <COND (.TEST? <GEN-TYPE? .REG <NODE-NAME <1 .K>> .BRANCH .DIR>)>
281 <COND (<OR <AND <NOT .TEST?> .DIR <==? <1 .TEST?> 2>>
282 <AND <NOT .TEST?> <NOT .DIR> <==? <1 .TEST?> 1>>>
283 <BRANCH-TAG .BRANCH>)>
284 <AND <ASSIGNED? B2> <LABEL-TAG .B2>>
290 <COND (.DIR .BRANCH) (ELSE .B2)>
294 <COND (.DIR .BRANCH) (ELSE .B2)>
296 <COND (<EMPTY? <SET K <REST .K 2>>>
297 <COND (<OR <AND <NOT .DIR> .TEST?>
299 <OR <AND .DIR <==? <1 .TEST?> 2>>
301 <==? <1 .TEST?> 1>>>>>
305 (<AND .FLS <NOT .TEST?> <NOT .BRANCH>>)
306 (<OR .NOTF <AND <NOT <==? <NOT .BRANCH> <NOT .DIR>>> <NOT .SETF>>>
312 <COND (<==? .WHERE DONT-CARE> <SET WHERE <GEN-TEMP <>>>)>
313 <DEALLOCATE-TEMP <MOVE-ARG <REFERENCE <NOT .SDIR>> .WHERE>>)>
315 <COND (<EMPTY? <REST .K>>
320 <COND (.BRANCH <NOT .DIR>) (ELSE .DIR)>>
325 <COND (<COND (.BRANCH <NOT .DIR>) (ELSE .DIR)>
331 <COND (<COND (.BRANCH <NOT .DIR>) (ELSE .DIR)>
335 <COND (<EMPTY? <SET K <REST .K 2>>>
336 <COND (<COND (.BRANCH .DIR) (ELSE <NOT .DIR>)>
340 <COND (<==? .WHERE DONT-CARE> <SET WHERE <GEN-TEMP <>>>)>
342 <SET WHERE <MOVE-ARG <REFERENCE .SDIR> .WHERE>>
345 (ELSE <TRUE-FALSE .NOD .B2 .WHERE>)>)
348 <COND (<OR <AND .DIR <==? <1 .TEST?> 2>>
349 <AND <NOT .DIR> <==? <1 .TEST?> 1>>>
350 <SET WHERE <MOVE-ARG <REFERENCE .SDIR> .WHERE>>
351 <BRANCH-TAG .BRANCH>)>)
352 (ELSE <SET WHERE <MOVE-ARG <==? <1 .TEST?> 2> .WHERE>>)>)>)
354 <COND (<NOT <TYPE? .WHERE TEMP>>
355 <COND (<AND <TYPE? .REG TEMP>
357 <L=? <TEMP-REFS .REG> 1>>
359 (ELSE <SET WHERE <GEN-TEMP <>>>)>)>
362 (<OR .TEST? <AND <G=? <LENGTH .K> 2> <==? <1 .TEST?> 2>>>
364 <DEALLOCATE-TEMP <SET WHERE <MOVE-ARG <REFERENCE <>> .WHERE>>>)>
366 <FUNCTION (TYL "AUX" (TY <1 .TYL>))
367 <COND (<NOT <AND <NOT .TEST?> <EMPTY? <REST .TYL>>>>
371 <COND (<OR <NOT .BRANCH> .DIR <NOT <EMPTY? <REST .TYL>>>>
375 <SET WHERE <MOVE-ARG <REFERENCE <NODE-NAME .TY>> .WHERE>>
376 <COND (<NOT .FIRST> <DEALLOCATE-TEMP .WHERE>) (ELSE <SET FIRST <>>)>
378 (<EMPTY? <REST .TYL>>
380 <COND (<AND .BRANCH .DIR> <BRANCH-TAG .BRANCH> <LABEL-TAG .B3>)
382 <BRANCH-TAG <SET B2 <MAKE-TAG>>>
384 <DEALLOCATE-TEMP <MOVE-ARG <REFERENCE <>> .WHERE>>
387 (ELSE <BRANCH-TAG .B2> <LABEL-TAG .B3>)>>
392 <COND (<OR <AND .DIR <==? <1 .TEST?> 2>>
393 <AND <NOT .DIR> <==? <1 .TEST?> 1>>>
395 <MOVE-ARG <REFERENCE <AND .DIR <NODE-NAME <1 .K>>>>
397 <BRANCH-TAG .BRANCH>)>)
400 <MOVE-ARG <REFERENCE <AND .DIR <NODE-NAME <1 .K>>>>
402 <MOVE-ARG .WHERE .RW>>
404 <DEFINE PGEN-DISPATCH (N W NF B D SF)
407 (,CALL-CODE <CALL-GEN .N .W .NF .B .D>)
408 (,COND-CODE <COND-GEN .N .W .NF .B .D>)
409 (,OR-CODE <OR-GEN .N .W .NF .B .D>)
410 (,AND-CODE <AND-GEN .N .W .NF .B .D>)
411 (,0-TST-CODE <0-TEST .N .W .NF .B .D .SF>)
412 (,NOT-CODE <NOT-GEN .N .W .NF .B .D .SF>)
413 (,1?-CODE <1?-GEN .N .W .NF .B .D .SF>)
414 (,TEST-CODE <TEST-GEN .N .W .NF .B .D .SF>)
415 (,EQ-CODE <==-GEN .N .W .NF .B .D .SF>)
416 (,TY?-CODE <TYPE?-GEN .N .W .NF .B .D .SF>)
417 (,MT-CODE <MT-GEN .N .W .NF .B .D .SF>)
418 (,MONAD-CODE <MT-GEN .N .W .NF .B .D .SF>)
419 (,ASSIGNED?-CODE <ASSIGNED?-GEN .N .W .NF .B .D .SF>)
420 (,GET-CODE <GET-GEN .N .W .NF .B .D .SF>)
421 (,GET2-CODE <GET2-GEN .N .W .NF .B .D .SF>)
422 (,MEMQ-CODE <MEMQ-GEN .N .W .NF .B .D .SF>)
423 (,LENGTH?-CODE <LENGTH?-GEN .N .W .NF .B .D .SF>)
424 (,GASSIGNED?-CODE <GASSIGNED?-GEN .N .W .NF .B .D .SF>)
425 (,VALID-CODE <VALID-TYPE?-GEN .N .W .NF .B .D .SF>)
426 (,=?-STRING-CODE <=?-STRING-GEN .N .W .NF .B .D .SF>)
427 (,SET-CODE <SET-GEN .N .W .NF .B .D>)
428 (,MAP-CODE <MAPFR-GEN .N .W .NF .B .D>)
429 (,PROG-CODE <PROG-REP-GEN .N .W .NF .B .D>)
431 (<COMPILE-LOSSAGE "Inconsisent use of predicate internally: "
434 <DEFINE PRED-BRANCH-GEN (TAG NOD TF
435 "OPTIONAL" (WHERE FLUSHED) (NF <>) (SETF <>)
437 <COND (<==? .WHERE FLUSHED> DONT-CARE)
438 (ELSE .WHERE)>) TT TAG2)
440 <COND (<==? <RESULT-TYPE .NOD> NO-RETURN> <GEN .NOD FLUSHED> ,NO-DATUM)
441 (<PRED-CHECK? .NOD .TF .WHERE>
442 <PGEN-DISPATCH .NOD .WHERE .NF .TAG .TF .SETF>)
444 <SET TT <GEN .NOD DONT-CARE>>
445 <COND (<==? .WHERE FLUSHED>
446 <D-B-TAG .TAG .TT <NOT .TF> <RESULT-TYPE .NOD>>)
448 <D-B-TAG <SET TAG2 <MAKE-TAG>>
453 <SET TT <MOVE-ARG <REFERENCE .TF> .WHERE>>
458 <SET TT <GEN .NOD .W2>>
459 <D-B-TAG .TAG .TT .TF <RESULT-TYPE .NOD>>
460 <MOVE-ARG .TT .WHERE>)>>
462 <DEFINE VALID-TYPE?-GEN (N W
463 "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>) (SETF <>)
464 "AUX" (NN <1 <KIDS .N>>) (SDIR .DIR) (RW .W)
465 (FLS <==? .RW FLUSHED>) B2 B3 DATA)
467 <COND (.NOTF <SET DIR <NOT .DIR>>)>
469 <COND (<AND .BRANCH .FLS>
470 <GEN-VT .DATA .BRANCH .DIR>
473 (<AND .FLS <NOT .BRANCH>>)
474 (<OR .NOTF <AND <NOT <==? <NOT .BRANCH> <NOT .DIR>>> <NOT .SETF>>>
477 <GEN-VT .DATA .B2 <COND (.BRANCH <NOT .DIR>) (ELSE .DIR)>>
479 <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP <>>>)>
481 <SET W <MOVE-ARG <REFERENCE .SDIR> .W>>
486 <MOVE-ARG <REFERENCE <NOT .SDIR>> .W>)>)
487 (ELSE <TRUE-FALSE .N .B2 .W>)>
492 <COND (<NOT <TYPE? .W TEMP>>
493 <COND (<AND <TYPE? .DATA TEMP> <L=? <TEMP-REFS .DATA> 1>>
495 (ELSE <SET W <GEN-TEMP <>>>)>)>
497 <DEALLOCATE-TEMP <MOVE-ARG <REFERENCE <>> .W>>)>
499 <COND (.BRANCH) (ELSE .B3)>
505 <MOVE-ARG <REFERENCE <>> .W>
509 <DEFINE TYPE-C-GEN (N W "AUX" (DATA <GEN <1 <KIDS .N>>>) (RW .W))
510 <COND (<NOT <TYPE? .W TEMP>>
511 <COND (<AND <TYPE? .DATA TEMP> <L=? <TEMP-REFS .DATA> 1>>
513 (ELSE <SET W <GEN-TEMP <>>>)>)>
518 <DEFINE =?-STRING-GEN (N W
519 "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>) (SETF <>)
520 "AUX" (N1 <1 <KIDS .N>>) (N2 <2 <KIDS .N>>) (SDIR .DIR)
521 (RW .W) (FLS <==? .RW FLUSHED>) B2 B3 L1 L2)
522 #DECL ((N N1 N2) NODE)
523 <COND (<==? <NODE-NAME .N> N=?> <SET NOTF <NOT .NOTF>>)>
525 <COND (.NOTF <SET DIR <NOT .DIR>>)>
528 <COND (.FLS .DIR) (ELSE <NOT .DIR>)>
529 <COND (.FLS .BRANCH) (ELSE <SET B2 <MAKE-TAG>>)>
533 <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP <>>>)>)>
534 <SET RW <MOVE-ARG <MOVE-ARG <REFERENCE .SDIR> .W> .RW>>
538 <DEALLOCATE-TEMP .RW>
539 <MOVE-ARG <REFERENCE <NOT .SDIR>> .RW>)>
541 (<==? <NODE-NAME .N> STRCOMP>
542 <DO-STR-EQ .N1 .N2 <> <> STRCOMP .W>)
544 <SET BRANCH <MAKE-TAG>>
545 <DO-STR-EQ .N1 .N2 .NOTF .BRANCH <NODE-NAME .N>>
546 <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP <>>>)>
547 <MOVE-ARG <REFERENCE T> .W>
549 <BRANCH-TAG <SET B2 <MAKE-TAG>>>
551 <MOVE-ARG <REFERENCE <>> .W>
555 <DEFINE DO-STR-EQ (N1 N2 DIR BR NM
557 "AUX" L1 L2 D1 D2 T1 T2 INS TG1 TG2 TG4 TG3 TG5)
559 <COND (.DIR <SET TG1 <MAKE-TAG>>)>
562 <COND (<AND <N==? .NM STRCOMP>
564 <N==? <ISTYPE? <RESULT-TYPE .N1>> STRING>>
565 <GEN-TYPE? .D1 STRING <COND (.DIR .TG1) (ELSE .BR)> <>>)
568 <N==? <ISTYPE? <RESULT-TYPE .N2>> STRING>>
569 <GEN-TYPE? .D2 STRING <COND (.DIR .TG1) (ELSE .BR)> <>>)>
570 <COND (<==? .NM STRCOMP>
571 <SET D1 <FIX-STR-TYP <RESULT-TYPE .N1> .D1>>
572 <SET D2 <FIX-STR-TYP <RESULT-TYPE .N2> .D2>>)>
575 <COND (<==? .NM STRCOMP> "STRCOMP") (ELSE "STRING-EQUAL?")>>>
576 <COND (<==? .NM STRCOMP>
582 <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP>>)
583 (<TYPE? .W TEMP> <USE-TEMP .W> .W)
585 (ELSE <IEMIT `STRING-EQUAL? .D1 .D2 <COND (.DIR +) (ELSE -)> .BR>)>
587 <IEMIT `IFCANNOT .INS>
588 <COND (<OR <TYPE? .D1 STRING> <AND <TYPE? .D1 TEMP> <G? <TEMP-REFS .D1> 1>>>
589 <SET D1 <MOVE-ARG .D1 <GEN-TEMP <>>>>)>
590 <COND (<OR <TYPE? .D2 STRING> <AND <TYPE? .D2 TEMP> <G? <TEMP-REFS .D2> 1>>>
591 <SET D2 <MOVE-ARG .D2 <GEN-TEMP <>>>>)>
592 <LENGTH-STRING .D1 <SET L1 <GEN-TEMP>>>
593 <COND (<==? .NM STRCOMP> <LENGTH-STRING .D2 <SET L2 <GEN-TEMP FIX>>>)
597 <COND (<==? <NODE-TYPE .N2> ,QUOTE-CODE>
598 <LENGTH <CHTYPE <NODE-NAME .N2> STRING>>)
600 <LENGTH-STRING .D2 <SET L2 <GEN-TEMP FIX>>>
604 <COND (.DIR .TG1) (ELSE .BR)>>)>
608 (<TEMP-NAME .D1> VALUE LENGTH)
609 (<TEMP-NAME .D2> VALUE LENGTH)
610 (<TEMP-NAME .L1> VALUE)
611 !<COND (<==? .NM STRCOMP> ((<TEMP-NAME .L2> VALUE))) (ELSE ())>>
612 <LABEL-TAG <SET TG2 <MAKE-TAG>>>
613 <NTH-STRING .D1 .T1 1>
614 <NTH-STRING .D2 .T2 1>
615 <GEN-VAL-==? .T1 .T2 <> <COND (.DIR .TG1) (ELSE .BR)>>
616 <COND (<N==? .NM STRCOMP> <FREE-TEMP .T1> <FREE-TEMP .T2>)>
617 <REST-STRING .D1 .D1 1>
618 <REST-STRING .D2 .D2 1>
619 <COND (<==? .NM STRCOMP>
620 <IEMIT `SUB .L2 1 = .L2 '(`TYPE FIX)>
621 <IEMIT `GRTR? .L2 0 - <SET TG3 <MAKE-TAG>> '(`TYPE FIX)>)>
622 <IEMIT `SUB .L1 1 = .L1 '(`TYPE FIX)>
623 <IEMIT `GRTR? .L1 0 + .TG2 '(`TYPE FIX)>
624 <COND (<==? .NM STRCOMP>
625 <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP FIX>>)>
627 <BRANCH-TAG <SET TG4 <MAKE-TAG>>>
629 <IEMIT `SUB .L1 1 = .L1 '(`TYPE FIX)>
630 <IEMIT `VEQUAL .L1 0 - <SET TG5 <MAKE-TAG>>>
637 <IEMIT `GRTR? .T1 .T2 - .TG5>
642 <COND (.DIR <BRANCH-TAG .BR>)>
646 <COND (.DIR <LABEL-TAG .TG1>)>
647 <COND (<ASSIGNED? W> .W)>>
649 <DEFINE FIX-STR-TYP (TYP D "AUX" B)
650 <COND (<TYPE? .TYP FORM>
651 <COND (<AND <TYPE? .D TEMP> <G? <TEMP-REFS .D> 1>>
652 <SET D <MOVE-ARG .D <GEN-TEMP <>>>>)>
653 <GEN-TYPE? .D STRING <SET B <MAKE-TAG>> T>
654 <IEMIT `NTHR .D 3 = .D>
658 <DEFINE ATOM-PART-GEN (N W
659 "AUX" D (NM <NODE-NAME .N>) (RW .W)
662 <OR <==? .NM LBIND> <==? .NM GBIND>>>))
664 <SET D <GEN <1 <KIDS .N>>>>
669 <COND (<==? .NM GBIND> 1)
674 <COND (<TYPE? .W TEMP> <USE-TEMP .W <ISTYPE? <RESULT-TYPE .N>>>)
675 (<OR <==? .W DONT-CARE> .CARE>
676 <SET W <GEN-TEMP <OR <ISTYPE? <RESULT-TYPE .N>> T>>>)
679 !<COND (.CARE ('(`BRANCH-FALSE + `COMPERR))) (ELSE ())>>
680 <COND (.CARE <SPEC-IEMIT `TYPE? .W '<`TYPE-CODE FALSE> + `COMPERR>)>
683 <DEFINE OFFSET-PART-GEN (N W
684 "AUX" D (NM <NODE-NAME .N>) (K <KIDS .N>)
685 E (RT <ISTYPE? <RESULT-TYPE .N>>))
686 #DECL ((N) NODE (K) <LIST [REST NODE]>)
688 <COND (<EMPTY? <SET K <REST .K>>>
692 <COND (<==? .NM INDEX> 1) (ELSE 3)>
694 <COND (<TYPE? .W TEMP> <USE-TEMP .W <OR .RT T>>)
695 (<==? .W DONT-CARE> <SET W <GEN-TEMP <OR .RT T>>>)
699 <IEMIT `PUTUV .D 3 .E>
701 <SET W <MOVE-ARG .D .W>>)>
704 <DEFINE PUT-GET-DECL-GEN (N W
705 "AUX" D D1 (NM <NODE-NAME .N>) (NN <1 <KIDS .N>>)
706 (ST <RESULT-TYPE .NN>) (RW .W))
708 <COND (<==? .NM GET-DECL>
711 <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP T>>)
712 (<TYPE? .W TEMP> <USE-TEMP .W>)>
713 <COND (<==? .ST OFFSET> <IEMIT `NTHUV .D 2 = .W>)
715 <IEMIT `NTHR .D 3 = .W (`RECORD-TYPE <ISTYPE? .ST>)>)>
718 <COND (<TYPE? .W TEMP> <SET D <GEN .NN .W>>)
719 (ELSE <SET D <GEN .NN>>)>
720 <SET D1 <GEN <2 <KIDS .N>>>>
721 <COND (<==? .W FLUSHED> <FREE-TEMP .D <>>)>
723 <COND (<==? .ST OFFSET> <IEMIT `PUTUV .D 2 .D1>)
725 <IEMIT `PUTR .D 3 .D1 (`RECORD-TYPE <ISTYPE? .ST>)>)>
726 <COND (<N==? .W FLUSHED> <SET W <MOVE-ARG .D .W>>)>
730 <DEFINE SUBSTRUC-GEN (N W
731 "AUX" (K <KIDS .N>) (PT <STRUCTYP <RESULT-TYPE .N>>)
732 (LN <LENGTH .K>) (OVERLAP T) (DIR <>) TMP1 TMP2
733 (RSTN <>) (LNTN <>) (STRN <1 .K>) (RESN <>) AMT NT
734 (THE-SYM <>) RSTK NN (SRC-REST 0) (DEST-REST 0)
736 #DECL ((STRN NN N) NODE (LN) FIX (RSTK K) <LIST [REST NODE]>
737 (RSTN LNTN RESN) <OR FALSE NODE> (SRC-REST DEST-REST) FIX)
742 <COND (<G? .LN 3> <SET RESN <4 .K>>)>)>)>
744 <==? <NODE-TYPE .RSTN> ,QUOTE-CODE>>
745 <SET SRC-REST <+ <NODE-NAME .RSTN> .SRC-REST>>)>
746 <COND (<AND <OR <AND <==? <SET NT <NODE-TYPE .STRN>> ,LVAL-CODE>
747 <SET THE-SYM <NODE-NAME .STRN>>>
748 <AND <==? .NT ,REST-CODE>
749 <==? <NODE-TYPE <SET NN <2 <SET RSTK <KIDS .STRN>>>>>
751 <SET SRC-REST <+ <NODE-NAME .NN> .SRC-REST>>
752 <==? <NODE-TYPE <SET NN <1 .RSTK>>> ,LVAL-CODE>
753 <SET THE-SYM <NODE-NAME .NN>>>>
755 <==? <NODE-TYPE .RSTN> ,QUOTE-CODE>
757 <OR <L? <LENGTH .LNTN> <CHTYPE <INDEX ,SIDE-EFFECTS> FIX>>
758 <NOT <SIDE-EFFECTS .LNTN>>>
760 <OR <AND <==? <SET NT <NODE-TYPE .RESN>> ,LVAL-CODE>
761 <==? <NODE-NAME .RESN> .THE-SYM>>
762 <AND <==? .NT ,REST-CODE>
763 <==? <NODE-TYPE <SET NN <2 <SET RSTK <KIDS .RESN>>>>>
765 <SET DEST-REST <NODE-NAME .NN>>
766 <==? <NODE-TYPE <SET NN <1 .RSTK>>> ,LVAL-CODE>
767 <==? <NODE-NAME .NN> .THE-SYM>>>>
768 <COND (<G? .SRC-REST .DEST-REST> <SET DIR `FORWARD>)
769 (<L? .SRC-REST .DEST-REST> <SET DIR `BACKWARD>)
770 ; "taa 5/26/88: Swapped the two directions, for the
771 sake of mnemonicity. When SRC-REST is greater than
772 DEST-REST, we can use what's conventionally known
773 as a FORWARD BLT, since the first word transferred
774 is not in the area being read, etc. When SRC-REST
775 is LESS than DEST-REST, we're potentially transferring
776 into the area that will later be read, and therefore
777 need to do it backwards. MIMOC20 in fact used to do
778 backwards blts with dir FORWARD, and vice versa..."
779 (ELSE <COMPILE-ERROR "Bogus SUBSTRUC turkey" .N>)>)
780 (<N==? .LN 4> <SET OVERLAP <>> <SET DIR `FORWARD>)>
784 <COND (<INTERFERE? <TEMP-NAME-SYM .THE-SYM> .NN>
787 <USE-TEMP <SET THE-SYM <TEMP-NAME-SYM .THE-SYM>>>)
788 (ELSE <SET THE-SYM <GEN .STRN <GEN-TEMP <>>>>)>
789 <COND (<==? .PT VECTOR> <SET RSTINS `RESTUV> <SET LNTINS `LENUV>)
790 (<==? .PT UVECTOR> <SET RSTINS `RESTUU> <SET LNTINS `LENUU>)
791 (<==? .PT STRING> <SET RSTINS `RESTUS> <SET LNTINS `LENUS>)
792 (ELSE <SET RSTINS `RESTUB> <SET LNTINS `LENUB>)>
793 <COND (<AND .RSTN <N==? <NODE-TYPE .RSTN> ,QUOTE-CODE>>
794 <SET TMP1 <GEN .RSTN>>
799 <COND (<L=? <TEMP-REFS .THE-SYM> 1> .THE-SYM)
802 <SET THE-SYM <GEN-TEMP .PT>>)>>
804 (<AND .RSTN <N==? .SRC-REST 0>>
809 <COND (<L=? <TEMP-REFS .THE-SYM> 1> .THE-SYM)
812 <SET THE-SYM <GEN-TEMP .PT>>)>>)>
813 <COND (.LNTN <SET TMP2 <GEN .LNTN>>)
814 (ELSE <IEMIT .LNTINS .THE-SYM = <SET TMP2 <GEN-TEMP FIX>>>)>
816 <SET TMP1 <GEN .RESN <COND (<AND <TYPE? .W TEMP> <N==? .W .THE-SYM>> .W)
818 <COND (<OR <==? .PT VECTOR> <==? .PT UVECTOR>>
830 (`NO-OVERLAP <NOT .OVERLAP>)>)>)
833 <FORM `TYPE-CODE .PT>
836 <COND (<AND <TYPE? .W TEMP> <N==? .W .THE-SYM>>
839 (ELSE <SET TMP1 <GEN-TEMP .PT>>)>
841 <COND (<OR <==? .PT VECTOR> <==? .PT UVECTOR>>
853 (`NO-OVERLAP <NOT .OVERLAP>)>)>)>