23 <USE "COMPDEC" "CODGEN" "CHKDCL" "SPCGEN" "CARGEN" "MIMGEN" "ADVMESS">
29 <MANIFEST MAX-IN-ROW CMAX-IN-ROW>
31 <DEFINE LIST-LNT-SPEC (N W NF BR DI NUM SF
32 "AUX" (K <KIDS .N>) REG RAC (FLS <==? .W FLUSHED>)
33 (B2 <COND (<AND .BR .FLS> .BR) (ELSE <MAKE-TAG>)>)
34 (SDIR .DI) (B3 <>) B4 F1 F2 F3
35 (SBR <NODE-NAME .N>) TT)
36 #DECL ((N) NODE (NUM) FIX (K) <LIST [REST NODE]>)
39 <1 <KIDS <COND (<==? <NODE-TYPE <1 .K>> ,QUOTE-CODE>
42 <AND .NF <SET DI <NOT .DI>>>
44 <DEALLOCATE-TEMP <MOVE-ARG <REFERENCE <NOT .SDIR>> .W>>)>
45 <SET DI <COND (<AND .BR <NOT .FLS>> <NOT .DI>) (ELSE .DI)>>
46 <AND .DI <SET SBR <FLIP .SBR>>>
47 <SET F1 <MEMQ .SBR '[==? G? G=? 1? 0?]>>
48 <SET F2 <MEMQ .SBR '[G? G=?]>>
49 <SET F3 <MEMQ .SBR '[L? L=?]>>
50 <COND (<OR <==? .SBR L=?> <==? .SBR G?>> <SET NUM <- .NUM 1>>)>
54 <COND (<L=? .NUM 0> .B2)
57 <OR .B3 <SET B3 <MAKE-TAG>>>)
59 <OR <NOT <0? .NUM>> <NOT .F1>>>
60 <COND (<L? <SET NUM <- .NUM 1>> 0>
61 <AND .B3 <LABEL-TAG .B3>>
65 <COND (<OR <NOT <TYPE? .REG TEMP>>
66 <G=? <TEMP-REFS .REG> 2>>
68 <SET REG <GEN-TEMP LIST>>)
73 <COND (<OR <NOT <TYPE? .REG TEMP>> <G=? <TEMP-REFS .REG> 2>>
74 <SET REG <MOVE-ARG .REG <GEN-TEMP <>>>>)>
75 <SET-TEMP <SET RAC <GEN-TEMP FIX>>
76 <COND (<OR .F2 .F3> <+ .NUM 1>) (ELSE .NUM)>
78 <IEMIT `LOOP (<TEMP-NAME .REG> VALUE) (<TEMP-NAME .RAC> VALUE)>
79 <LABEL-TAG <SET B4 <MAKE-TAG>>>
81 <COND (<AND <NOT .F3> <OR .F2 <NOT .F1>>>
82 <OR .B3 <SET B3 <MAKE-TAG>>>)
85 <REST-LIST .REG .REG 1>
86 <IEMIT `SUB .RAC 1 = .RAC '(`TYPE FIX)>
87 <IEMIT `GRTR? .RAC 0 + .B4 '(`TYPE FIX)>
88 <COND (<OR .F3 .F2> <AND .B3 <BRANCH-TAG .B2>>)
89 (ELSE <EMPTY-LIST .REG .B2 <NOT .F1>>)>
90 <COND (.B3 <LABEL-TAG .B3>)>
93 <COND (<NOT .BR> <TRUE-FALSE .N .B2 .W>)
95 <SET W <MOVE-ARG <REFERENCE .SDIR> .W>>
100 <DEFINE LNTH-GEN (NOD WHERE
101 "AUX" (STRN <1 <KIDS .NOD>>) T1 T2 STR
102 (ITYP <RESULT-TYPE .STRN>) (TYP <STRUCTYP .ITYP>))
103 #DECL ((STRN NOD) NODE (K) <LIST [REST NODE]> (T1 T2) ATOM)
104 <SET STR <GEN .STRN DONT-CARE>>
106 <COND (<==? .WHERE DONT-CARE> <SET WHERE <GEN-TEMP FIX>>)
107 (<TYPE? .WHERE TEMP> <USE-TEMP .WHERE FIX>)>
108 <COND (<==? .TYP LIST> <LENGTH-LIST .STR .WHERE>)
109 (<OR <==? .TYP VECTOR>
111 <LENGTH-VECTOR .STR .WHERE>)
112 (<==? .TYP STRING> <LENGTH-STRING .STR .WHERE>)
113 (<==? .TYP BYTES> <LENGTH-BYTES .STR .WHERE>)
114 (<==? .TYP UVECTOR> <LENGTH-UVECTOR .STR .WHERE>)
115 (<==? .TYP TEMPLATE> <LENGTH-RECORD .STR .WHERE .ITYP>)
116 (ELSE <LENGTH-RECORD .STR .WHERE .TYP>)>
119 <DEFINE MONAD?-GEN (NOD WHERE) <MT-GEN .NOD .WHERE>>
121 <DEFINE MT-GEN (NOD WHERE
122 "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>) (SETF <>)
123 "AUX" (STRN <1 <KIDS .NOD>>) STR (ITYP <RESULT-TYPE .STRN>)
124 (SDIR .DIR) (TYP <STRUCTYP .ITYP>) (TY <ISTYPE? .ITYP>)
125 (FLS <==? .WHERE FLUSHED>)
127 <COND (<AND .BRANCH .FLS> .BRANCH) (ELSE <MAKE-TAG>)>))
128 #DECL ((STRN NOD) NODE (B2) ATOM (BRANCH) <OR ATOM FALSE>)
129 <COND (<==? .WHERE DONT-CARE> <SET WHERE <GEN-TEMP <>>>)>
130 <AND .NOTF <SET DIR <NOT .DIR>>>
132 <DEALLOCATE-TEMP <MOVE-ARG <REFERENCE <NOT .SDIR>> .WHERE>>)>
133 <SET DIR <COND (<AND .BRANCH <NOT .FLS>> <NOT .DIR>) (ELSE .DIR)>>
134 <SET STR <GEN .STRN>>
135 <COND (<==? <NODE-TYPE .NOD> ,MONAD-CODE>
136 <IEMIT `MONAD? .STR <COND (.DIR +) (ELSE -)> .B2>)
137 (<==? .TYP LIST> <EMPTY-LIST .STR .B2 .DIR .TY>)
138 (<OR <==? .TYP VECTOR>
140 <EMPTY-VECTOR .STR .B2 .DIR .TY>)
141 (<==? .TYP UVECTOR> <EMPTY-UVECTOR .STR .B2 .DIR .TY>)
142 (<==? .TYP STRING> <EMPTY-STRING .STR .B2 .DIR .TY>)
143 (<==? .TYP BYTES> <EMPTY-BYTES .STR .B2 .DIR .TY>)
144 (<==? .TYP TEMPLATE> <EMPTY-RECORD .STR .B2 .DIR .ITYP>)
145 (<ISTYPE? .ITYP> <EMPTY-RECORD .STR .B2 .DIR .TYP>)
146 (ELSE <IEMIT `EMPTY? .STR <COND (.DIR +) (ELSE -)> .B2>)>
148 <COND (<NOT .BRANCH> <TRUE-FALSE .NOD .B2 .WHERE>)
150 <SET WHERE <MOVE-ARG <REFERENCE .SDIR> .WHERE>>
155 <DEFINE REST-GEN (NOD WHERE
156 "AUX" (STRNOD <1 <KIDS .NOD>>) (NUMNOD <2 <KIDS .NOD>>)
157 (TYP <RESULT-TYPE .STRNOD>) (TPS <STRUCTYP .TYP>)
158 (NUMKN <==? <NODE-TYPE .NUMNOD> ,QUOTE-CODE>)
161 <COND (<TYPE? <NODE-NAME .NUMNOD> OFFSET>
162 <INDEX <NODE-NAME .NUMNOD>>)
164 <NODE-NAME .NUMNOD>)>)
166 (ML <MINL .TYP>) STR NUMN (ONO .NO-KILL)
167 (NO-KILL .ONO) (LCAREFUL .CAREFUL) (W .WHERE) RV
168 (NEED-CHTYPE <OR <N==? <ISTYPE? .TYP> .TPS>
169 <==? <NODE-TYPE .STRNOD>
171 (NR <GET-RANGE <RESULT-TYPE .NUMNOD>>))
172 #DECL ((NOD NUMNOD STRNOD) NODE (ML N MP NUM) FIX
173 (NUMNK RV) <OR ATOM FALSE> (NR) <OR FALSE <LIST FIX FIX>>
174 (NO-KILL) <SPECIAL LIST>)
175 <SET RV <COMMUTE-STRUC <> .STRNOD .NUMNOD>>
178 <COMPILE-ERROR "Negative " <NODE-NAME .NOD> .NOD>)
180 <COND (<==? .WHERE DONT-CARE>
181 <SET WHERE <SET W <GEN-TEMP>>>)
183 <USE-TEMP .WHERE <COND (.NEED-CHTYPE ANY)
185 (<AND <==? .WHERE ,POP-STACK> .NEED-CHTYPE>
186 <SET W <GEN-TEMP ANY>>)>
187 <SET STR <GEN .STRNOD .W>>)
188 (<AND <==? .TPS LIST>
189 <OR <AND .LCAREFUL <G? .NUM .ML>>
190 <L=? .NUM ,MAX-IN-ROW>>>
191 <COND (<==? .WHERE DONT-CARE>
192 <SET WHERE <SET W <GEN-TEMP <>>>>)
193 (<TYPE? .WHERE TEMP>)
194 (<AND <==? .WHERE ,POP-STACK> .NEED-CHTYPE>
195 <SET W <GEN-TEMP <>>>)>
198 <GEN .STRNOD> .NUM .ML .LCAREFUL .W>>)
200 <SET STR <GEN .STRNOD>>
201 <COND (<AND .LCAREFUL <G? .NUM .ML>>
202 <LENGTH-CHECK .TPS .STR .NUM <RECTYPE? .TYP>>)>
204 <COND (<==? .WHERE DONT-CARE>
205 <SET WHERE <SET W <GEN-TEMP <COND (.NEED-CHTYPE
209 <USE-TEMP .WHERE <COND (.NEED-CHTYPE ANY)
211 (<AND <==? .WHERE ,POP-STACK> .NEED-CHTYPE>
213 <REST-DO .TPS .STR .W .NUM <RECTYPE? .TYP>>)
215 <SET STR <GEN .STRNOD>>
217 <COND (<==? .WHERE DONT-CARE>
218 <SET WHERE <SET W <GEN-TEMP>>>)
219 (<TYPE? .WHERE TEMP> <USE-TEMP .WHERE>)>
221 <IEMIT `REST1 .STR = .W>)>
223 <GEN-CHTYPE .W .TPS .WHERE>)>
227 <SET NUMN <GEN .NUMNOD DONT-CARE>>
228 <SET NUMN <INTERF-CHANGE .NUMN .STRNOD>>
229 <SET STR <GEN .STRNOD DONT-CARE>>)
231 <SET STR <GEN .STRNOD DONT-CARE>>
232 <SET STR <INTERF-CHANGE .STR .NUMNOD>>
233 <SET NUMN <GEN .NUMNOD DONT-CARE>>)>
234 <COND (<AND .LCAREFUL
235 <NOT <AND .NR <G=? <1 .NR> 0>>>
237 <LENGTH-CHECK .TPS .STR .NUMN <RECTYPE? .TYP>>)>
238 <COND (<N==? .TPS LIST>
240 <FREE-TEMP .NUMN <>>)>
241 <COND (<==? .TPS LIST>
242 <COND (<AND <==? .WHERE ,POP-STACK> .NEED-CHTYPE>
245 <EXPANDED-LIST-REST .STR
250 <COND (<OR <NOT .NEED-CHTYPE>
251 <==? .WHERE DONT-CARE>>
254 <COND (<==? .WHERE DONT-CARE>
255 <SET WHERE <SET W <GEN-TEMP <COND (.NEED-CHTYPE
259 <USE-TEMP .WHERE <COND (.NEED-CHTYPE ANY)
261 (<AND <==? .WHERE ,POP-STACK> .NEED-CHTYPE>
263 <REST-DO .TPS .STR .W .NUMN <RECTYPE? .TYP>>)>
265 <GEN-CHTYPE .W .TPS .WHERE>)>
268 <DEFINE REST-DO (TPS STR WHERE NUM "OPTIONAL" (TYP ANY))
269 <COND (<OR <==? .TPS VECTOR>
271 <REST-VECTOR .STR .WHERE .NUM .TPS>)
272 (<==? .TPS UVECTOR> <REST-UVECTOR .STR .WHERE .NUM>)
273 (<==? .TPS STRING> <REST-STRING .STR .WHERE .NUM>)
274 (<==? .TPS BYTES> <REST-BYTES .STR .WHERE .NUM>)
275 (<==? .TPS LIST> <REST-LIST .STR .WHERE .NUM>)
276 (<==? .TPS TEMPLATE> <REST-RECORD .STR .WHERE .NUM .TYP>)
277 (ELSE <REST-RECORD .STR .WHERE .NUM .TPS>)>>
279 <DEFINE NTH-GEN (NOD WHERE
280 "AUX" (K <KIDS .NOD>) STR (TYP <RESULT-TYPE <1 .K>>)
281 (TPS <STRUCTYP .TYP>) (2ARG <2 .K>) NUMN
282 (NUMKN <==? <NODE-TYPE .2ARG> ,QUOTE-CODE>)
285 <COND (<TYPE? <NODE-NAME .2ARG> OFFSET>
286 <INDEX <NODE-NAME .2ARG>>)
287 (ELSE <NODE-NAME .2ARG>)>)
288 (ELSE 1)>) (NR <GET-RANGE <RESULT-TYPE .2ARG>>)
289 (TEM <>) (1ARG <1 .K>) NDAT
290 (DONE <>) FLS (LCAREFUL .CAREFUL) (ML <MINL .TYP>)
291 (RV <==? <NODE-NAME .NOD> INTH>)
292 (RESTYP <ISTYPE? <RESULT-TYPE .NOD>>))
293 #DECL ((NOD) NODE (K) <LIST NODE NODE> (TPS) ANY (NUM ML COD) FIX)
294 <COND (.NUMKN <PUT .2ARG ,NODE-NAME .NUM>)>
297 <COMPILE-ERROR "Negative or 0 "
301 <SET STR <GEN .1ARG>>
302 <COND (<AND .TPS .LCAREFUL <0? .ML>>
303 <EMPTY-CHECK .TPS .STR <RECTYPE? .TYP>>)>
305 <COND (<==? .WHERE DONT-CARE>
306 <SET WHERE <GEN-TEMP <RESULT-TYPE .NOD>>>)
308 <USE-TEMP .WHERE <RESULT-TYPE .NOD>>)>
310 <NTH-DO .TPS .STR .WHERE 1 <RECTYPE? .TYP>
312 (ELSE <IEMIT `NTH1 .STR = .WHERE>)>)
313 (<AND <==? .TPS LIST>
314 <OR <AND .LCAREFUL <G? .NUM .ML>>
315 <L=? .NUM ,MAX-IN-ROW>>>
318 <GEN .1ARG> .NUM .ML .LCAREFUL>>
320 <COND (<==? .WHERE DONT-CARE>
321 <SET WHERE <GEN-TEMP <RESULT-TYPE .NOD>>>)
323 <USE-TEMP .WHERE <RESULT-TYPE .NOD>>)>
324 <NTH-DO LIST .STR .WHERE 1 LIST .RESTYP>)
326 <SET STR <GEN .1ARG DONT-CARE>>
327 <COND (<AND .LCAREFUL <G? .NUM .ML>>
329 .TPS .STR .NUM <RECTYPE? .TYP>>)>
331 <COND (<==? .WHERE DONT-CARE>
332 <SET WHERE <GEN-TEMP <RESULT-TYPE .NOD>>>)
334 <USE-TEMP .WHERE <RESULT-TYPE .NOD>>)>
335 <NTH-DO .TPS .STR .WHERE .NUM <RECTYPE? .TYP>
339 <SET NUMN <GEN .2ARG DONT-CARE>>
340 <SET NUMN <INTERF-CHANGE .NUMN .1ARG>>
341 <SET STR <GEN .1ARG DONT-CARE>>)
343 <SET STR <GEN .1ARG DONT-CARE>>
344 <SET STR <INTERF-CHANGE .STR .2ARG>>
345 <SET NUMN <GEN .2ARG DONT-CARE>>)>
346 <COND (<AND .LCAREFUL
347 <NOT <AND .NR <G? <1 .NR> 0>>>
349 <LENGTH-CHECK .TPS .STR .NUMN <RECTYPE? .TYP>>)>
350 <COND (<==? .WHERE DONT-CARE>
351 <SET WHERE <GEN-TEMP <RESULT-TYPE .NOD>>>)
353 <USE-TEMP .WHERE <RESULT-TYPE .NOD>>)>
354 <COND (<==? .TPS LIST>
356 <EXPANDED-LIST-REST .STR .NUMN .ML .LCAREFUL>>
357 <NTH-DO LIST .STR .WHERE 1 LIST .RESTYP>
360 <NTH-DO .TPS .STR .WHERE .NUMN <RECTYPE? .TYP>
363 <FREE-TEMP .NUMN <>>)>)>
366 <DEFINE EXPANDED-LIST-REST (STR NUM ML LCAREFUL
368 "AUX" TG1 TG2 (NUMN .NUM))
370 <COND (<AND <TYPE? .NUM FIX> <NOT <ASSIGNED? W>>>
371 <SET NUM <- .NUM 1>>)>
372 <COND (<AND <TYPE? .NUM FIX>
374 <COND (.LCAREFUL ,CMAX-IN-ROW) (ELSE ,MAX-IN-ROW)>>>
376 <COND (<AND <L=? .ML 0> .LCAREFUL>
377 <EMPTY-CHECK LIST .STR LIST>)>
378 <COND (<AND <ASSIGNED? W> <1? .NUM>>
380 <COND (<==? .W DONT-CARE>
381 <SET W <GEN-TEMP LIST>>)
382 (<TYPE? .W TEMP> <USE-TEMP .W LIST>)>
383 <REST-DO LIST .STR .W 1>
385 (<AND <TYPE? .STR TEMP>
386 <OR <L=? <TEMP-REFS .STR> 1>
387 <AND <ASSIGNED? W> <==? .STR .W>>>>
388 <REST-DO LIST .STR .STR 1>)
391 <REST-DO LIST .STR <SET STR <GEN-TEMP LIST>> 1>)>
392 <COND (<L=? <SET NUM <- .NUM 1>> 0>
393 <COND (<AND .LCAREFUL
396 <EMPTY-CHECK LIST .STR LIST>)>
400 <COND (<NOT <AND <TYPE? .NUM TEMP> <L=? <TEMP-REFS .NUM> 1>>>
401 <SET NUMN <MOVE-ARG .NUM <GEN-TEMP <>>>>)>
402 <SET TG1 <MAKE-TAG "RESTL">>
403 <COND (<NOT <AND <TYPE? .STR TEMP>
404 <OR <L=? <TEMP-REFS .STR> 1>
405 <AND <ASSIGNED? W> <==? .W .STR>>>>>
406 <SET STR <MOVE-ARG .STR <GEN-TEMP <>>>>)>
407 <COND (<NOT <TYPE? .NUM FIX>>
408 <SET TG2 <MAKE-TAG "RESTL">>
409 <COND (<NOT <ASSIGNED? W>>
410 <IEMIT `SUB .NUMN 1 = .NUMN '(`TYPE FIX)>)>
411 <IEMIT `GRTR? .NUMN 0 - .TG2 '(`TYPE FIX)>)>
412 <IEMIT `LOOP (<TEMP-NAME .STR> VALUE) (<TEMP-NAME .NUMN> VALUE)>
415 <COND (<AND .LCAREFUL <OR <NOT <TYPE? .NUM FIX>> <G? .NUM .ML>>>
416 <EMPTY-CHECK LIST .STR LIST>)>
417 <REST-DO LIST .STR .STR 1>
418 <IEMIT `SUB .NUMN 1 = .NUMN '(`TYPE FIX)>
419 <IEMIT `GRTR? .NUMN 0 + .TG1 '(`TYPE FIX)>
420 <COND (<ASSIGNED? TG2> <LABEL-TAG .TG2>)>
422 <COND (<AND .LCAREFUL <NOT <ASSIGNED? W>>>
423 <EMPTY-CHECK LIST .STR LIST>)>
424 <COND (<ASSIGNED? W> <SET STR <MOVE-ARG .STR .W>>)>)>
427 <DEFINE NTH-DO (TPS STR WHERE NUM "OPTIONAL" (TYP ANY) (RESTYP <>))
428 <COND (<OR <==? .TPS VECTOR>
430 <NTH-VECTOR .STR .WHERE .NUM .RESTYP>)
431 (<==? .TPS UVECTOR> <NTH-UVECTOR .STR .WHERE .NUM .RESTYP>)
432 (<==? .TPS STRING> <NTH-STRING .STR .WHERE .NUM .RESTYP>)
433 (<==? .TPS BYTES> <NTH-BYTES .STR .WHERE .NUM .RESTYP>)
434 (<==? .TPS LIST> <NTH-LIST .STR .WHERE .NUM .RESTYP>)
435 (<==? .TPS TEMPLATE> <NTH-RECORD .STR .WHERE .NUM .TYP .RESTYP>)
436 (ELSE <NTH-RECORD .STR .WHERE .NUM .TPS .RESTYP>)>>
438 <SETG STYPES [LIST TUPLE VECTOR UVECTOR STORAGE STRING BYTES TEMPLATE]>
440 <DEFINE NTH-PRED (C) #DECL ((C) FIX) <==? .C 1>>
442 <DEFINE PUT-GEN (NOD WHERE
443 "OPTIONAL" (SAME? <>)
444 "AUX" (ONO .NO-KILL) (K <KIDS .NOD>) (SNOD <1 .K>)
445 (NNOD <2 .K>) (VNOD <3 .K>) (TYP <RESULT-TYPE .SNOD>)
446 (TPS <STRUCTYP .TYP>) (ML <MINL .TYP>) VN STR NUMN
447 (NUMKN <==? <NODE-TYPE .NNOD> ,QUOTE-CODE>)
450 <COND (<TYPE? <NODE-NAME .NNOD> OFFSET>
451 <INDEX <NODE-NAME .NNOD>>)
452 (ELSE <NODE-NAME .NNOD>)>)
454 (RV <AND <NOT .SAME?> <COMMUTE-STRUC <> .NNOD .SNOD>>)
457 <COMMUTE-STRUC <> .VNOD .SNOD>
458 <COMMUTE-STRUC <> .VNOD .NNOD>>)
459 (NR <GET-RANGE <RESULT-TYPE .NNOD>>) ETYP (W .WHERE)
461 #DECL ((NOD) NODE (K) <LIST NODE NODE NODE> (NUM ML) FIX)
462 <COND (.NUMKN <PUT .NNOD ,NODE-NAME .NUM>)>
463 <SET ETYP <GET-ELE-TYPE .TYP <COND (.NUMKN .NUM) (ALL)>>>
464 <COND (<AND <MEMQ <STRUCTYP .ETYP> '[VECTOR UVECTOR STRING BYTES]>
465 <NOT <TYPE? .ETYP SEGMENT>>
466 <OR <NOT <TYPE? .ETYP ATOM>>
467 <NOT <TYPE? <DECL-GET .ETYP> SEGMENT>>>>
469 (<N==? <SET ETYP <ISTYPE? .ETYP>> <ISTYPE? <RESULT-TYPE .VNOD>>>
474 (<NOT <G? .NUM 0>> <COMPILE-ERROR "PUT Number to small: " .NUM .NOD>)
477 <SET VN <GEN .VNOD DONT-CARE>>
478 <SET VN <INTERF-CHANGE .VN .SNOD>>
479 <SET STR <GEN .SNOD DONT-CARE>>
480 <COND (<AND <0? .ML> .CAREFUL>
481 <EMPTY-CHECK .TPS .STR <RECTYPE? .TYP>>)>)
483 <SET STR <GEN .SNOD DONT-CARE>>
484 <COND (<AND .CAREFUL <0? .ML>>
485 <EMPTY-CHECK .TPS .STR <RECTYPE? .TYP>>)>
487 <SET STR <INTERF-CHANGE .STR .VNOD>>
488 <SET VN <GEN .VNOD DONT-CARE>>)>)>
489 <DELAY-KILL .NO-KILL .ONO>
490 <COND (.SAME? <SPEC-GEN .VNOD .STR .TPS .NUM>)
491 (ELSE <DATCLOB .STR .NUM .VN .TPS .TYP .ETYP>)>
492 <COND (<NOT .SAME?> <FREE-TEMP .VN>)>
493 <SET W <MOVE-ARG .STR .W>>)
496 <SET VN <GEN .VNOD DONT-CARE>>
497 <SET VN <INTERF-CHANGE .VN .SNOD>>
498 <SET STR <GEN .SNOD DONT-CARE>>)
500 <SET STR <GEN .SNOD DONT-CARE>>
502 <SET STR <INTERF-CHANGE .STR .VNOD>>
503 <SET VN <GEN .VNOD DONT-CARE>>)>)>
504 <DELAY-KILL .NO-KILL .ONO>
505 <COND (<AND .CAREFUL <L? .ML .NUM> <NOT .SAME?> <N==? .TPS LIST>>
506 <LENGTH-CHECK .TPS .STR .NUM <RECTYPE? .TYP>>)>
509 (.SAME? <SPEC-GEN .VNOD .STR .TPS 1>)
511 <COND (<AND <==? .TPS LIST>
512 <OR <AND .CAREFUL <G? .NUM .ML>> <L=? .NUM ,MAX-IN-ROW>>>
515 <USE-TEMP .STR> .NUM .ML .CAREFUL>>
521 (ELSE <DATCLOB .STR .NUM .VN .TPS .TYP .ETYP>)>)>
522 <COND (<N==? .FOO .STR> <FREE-TEMP .FOO>)>
523 <COND (<NOT .SAME?> <FREE-TEMP .VN>)>
524 <SET W <MOVE-ARG .STR .W>>)>)
527 <SET VN <GEN .VNOD DONT-CARE>>
528 <SET VN <INTERF-CHANGE .VN .SNOD>>
529 <SET VN <INTERF-CHANGE .VN .NNOD>>)>
531 <SET NUMN <GEN .NNOD DONT-CARE>>
532 <SET NUMN <INTERF-CHANGE .NUMN .SNOD>>
533 <SET STR <GEN .SNOD DONT-CARE>>
535 <SET NUMN <INTERF-CHANGE .NUMN .VNOD>>
536 <SET STR <INTERF-CHANGE .STR .VNOD>>)>)
538 <SET STR <GEN .SNOD DONT-CARE>>
539 <SET STR <INTERF-CHANGE .STR .NNOD>>
540 <SET NUMN <GEN .NNOD DONT-CARE>>
542 <SET NUMN <INTERF-CHANGE .NUMN .VNOD>>
543 <SET STR <INTERF-CHANGE .STR .VNOD>>)>)>
544 <COND (.RR <DELAY-KILL .NO-KILL .ONO>)>
545 <COND (<AND .CAREFUL <NOT <AND .NR <G? <1 .NR> 0>>>>
546 <IEMIT `GRTR? .NUMN 0 - `COMPERR '(`TYPE FIX)>)>
549 <NOT <AND .NR <L=? <2 .NR> <MINL .TYP>>>>>
550 <LENGTH-CHECK .TPS .STR .NUMN <RECTYPE? .TYP>>)>
552 <DELAY-KILL .NO-KILL .ONO>
553 <COND (<NOT .SAME?> <SET VN <GEN .VNOD DONT-CARE>>)>)>
554 <COND (.SAME? <SPEC-GEN .VNOD .NUMN .TPS 0>)
556 <COND (<AND <==? .TPS LIST> .CAREFUL>
557 <SET STR <EXPANDED-LIST-REST .STR .NUMN .ML .CAREFUL>>
558 <DATCLOB .STR 1 .VN .TPS .TYP .ETYP>)
560 <DATCLOB .STR .NUMN .VN .TPS .TYP .ETYP>
561 <FREE-TEMP .NUMN>)>)>
562 <COND (<NOT .SAME?> <FREE-TEMP .VN>)>
563 <SET W <MOVE-ARG .STR .W>>)>
566 <DEFINE DATCLOB (STR NUM VDAT TPS TYP ETYP "AUX" TT TEM)
567 <COND (.ETYP <SET ETYP (`TYPE .ETYP)>)>
568 <COND (<==? .TPS LIST> <PUT-LIST .STR .NUM .VDAT .ETYP>)
569 (<OR <==? .TPS VECTOR>
571 <PUT-VECTOR .STR .NUM .VDAT .ETYP>)
572 (<==? .TPS UVECTOR> <PUT-UVECTOR .STR .NUM .VDAT>)
573 (<==? .TPS STRING> <PUT-STRING .STR .NUM .VDAT>)
574 (<==? .TPS BYTES> <PUT-BYTES .STR .NUM .VDAT>)
576 <PUT-RECORD .STR .NUM .VDAT <RECTYPE? .TYP> .ETYP>)
577 (ELSE <PUT-RECORD .STR .NUM .VDAT .TPS .ETYP>)>>
579 <DEFINE RECTYPE? (TYP)
580 <COND (<ISTYPE? .TYP>)
581 (<AND <TYPE? .TYP FORM SEGMENT>
584 <RECTYPE? <2 .TYP>>)>>
586 <DEFINE PUTREST-GEN (NOD WHERE
587 "AUX" ST1 ST2 (K <KIDS .NOD>) (ONO .NO-KILL)
588 (NO-KILL .ONO) (2RET <>))
589 #DECL ((NOD N) NODE (K) <LIST NODE NODE> (NO-KILL) <SPECIAL LIST>
591 <COND (<==? <NODE-SUBR .NOD> ,REST>
595 <COND (<AND <==? <NODE-TYPE <2 .K>> ,QUOTE-CODE>
596 <==? <NODE-NAME <2 .K>> ()>>
597 <SET ST1 <GEN <1 .K> DONT-CARE>>)
599 <SET ST1 <GEN <1 .K> DONT-CARE>>
600 <SET ST1 <INTERF-CHANGE .ST1 <2 .K>>>
601 <SET ST2 <GEN <2 .K> DONT-CARE>>)>
602 <COND (<AND .CAREFUL <G? 1 <MINL <RESULT-TYPE <1 .K>>>>>
603 <EMPTY-CHECK LIST .ST1 LIST>)>
604 <COND (<ASSIGNED? ST2> <IEMIT `PUTREST .ST1 .ST2>)
605 (ELSE <IEMIT `PUTREST .ST1 ()>)>
606 <MOVE-ARG <COND (.2RET <FREE-TEMP .ST1> .ST2)
607 (ELSE <FREE-TEMP .ST2> .ST1)>
610 <DEFINE SIDE-EFFECTS? (N)
612 <AND <N==? <NODE-TYPE .N> ,QUOTE-CODE> <SIDE-EFFECTS .N>>>
614 <DEFINE COMMUTE-STRUC (RV NUMNOD STRNOD "AUX" N (L .NO-KILL) CD (FLG T))
615 #DECL ((NO-KILL) LIST (NUMNOD STRNOD) NODE (L) LIST)
616 <COND (<OR <AND <NOT .RV>
617 <OR <AND <==? <NODE-TYPE .NUMNOD> ,QUOTE-CODE>
619 <NOT <SIDE-EFFECTS .NUMNOD>>>
620 <MEMQ <SET CD <NODE-TYPE <SET N .STRNOD>>> ,SNODES>>
622 <OR <AND <==? <NODE-TYPE .STRNOD> ,QUOTE-CODE>
624 <NOT <SIDE-EFFECTS .STRNOD>>>
625 <NOT <MEMQ <SET CD <NODE-TYPE <SET N .NUMNOD>>> ,SNODES>>>>
628 <COND (<==? <LENGTH <SET CD <TYPE-INFO .N>>> 2> <2 .CD>)
630 <SET CD <NODE-NAME .N>>
633 #DECL ((LL) <LIST SYMTAB ANY>)
634 <AND <==? .CD <1 .LL>> <MAPLEAVE>>>
636 <SET NO-KILL ((.CD <>) !.L)>)>
642 <DEFINE EMPTY-CHECK (TPS STR TYP "OPTIONAL" (DIR T) (TG `COMPERR))
643 <COND (<OR <==? .TPS VECTOR>
645 <EMPTY-VECTOR .STR .TG .DIR>)
646 (<==? .TPS UVECTOR> <EMPTY-UVECTOR .STR .TG .DIR>)
647 (<==? .TPS STRING> <EMPTY-STRING .STR .TG .DIR>)
648 (<==? .TPS BYTES> <EMPTY-BYTES .STR .TG .DIR>)
649 (<==? .TPS LIST> <EMPTY-LIST .STR .TG .DIR>)
650 (<==? .TPS TEMPLATE> '<EMPTY-RECORD .STR .TG .DIR .TYP>)
651 (ELSE '<EMPTY-RECORD .STR .TG .DIR .TPS>)>>
653 <DEFINE LENGTH-CHECK (TPS STR NUM TYP "AUX" (TMP <GEN-TEMP FIX>))
655 <COND (<OR <==? .TPS VECTOR>
657 <LENGTH-VECTOR .STR .TMP>)
658 (<==? .TPS LIST> <LENGTH-LIST .STR .TMP>)
659 (<==? .TPS UVECTOR> <LENGTH-UVECTOR .STR .TMP>)
660 (<==? .TPS STRING> <LENGTH-STRING .STR .TMP>)
661 (<==? .TPS BYTES> <LENGTH-BYTES .STR .TMP>)
665 <IEMIT `LESS? .TMP .NUM + `COMPERR '(`TYPE FIX)>
668 <DEFINE TOP-GEN (N W "AUX" D)
670 <SET D <GEN <1 <KIDS .N>> DONT-CARE>>
672 <IEMIT `TOPU .D = <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP>>)
673 (<TYPE? .W TEMP> <USE-TEMP .W> .W)
677 <DEFINE BACK-GEN (N W "AUX" D NN (K <KIDS .N>))
678 #DECL ((N) NODE (K) <LIST [REST NODE]>)
679 <SET D <GEN <1 .K> DONT-CARE>>
680 <COND (<OR <AND <EMPTY? <REST .K>> <SET NN 1>>
681 <AND <==? <NODE-TYPE <2 .K>> ,QUOTE-CODE>
682 <SET NN <NODE-NAME <2 .K>>>>>
683 <COND (<TYPE? .NN OFFSET>
684 <SET NN <INDEX .NN>>)>
690 <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP>>)
691 (<TYPE? .W TEMP> <USE-TEMP .W> .W)
694 <FREE-TEMP <SET NN <GEN <2 .K> DONT-CARE>> <>>
700 <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP>>)
701 (<TYPE? .W TEMP> <USE-TEMP .W> .W)