6 <USE "COMPDEC" "CODGEN" "CHKDCL" "ADVMESS" "MIMGEN" "STRGEN">
8 <DEFINE LIST-BUILD (NOD W
9 "AUX" (K <KIDS .NOD>) (KK ()) N TEM TT T1 D1 D2 D3
10 (OOPSF <>) TG1 TG2 (SUGGEST DONT-CARE))
11 #DECL ((K KK) <LIST [REST NODE]> (N NOD) NODE)
12 <COND (<AND <TYPE? .W TEMP> <==? <TEMP-REFS .W> 0>> <SET SUGGEST .W>)>
15 <AND <==? <LENGTH .K> 1> <SET KK .K>>
19 <COND (<AND <G=? <LENGTH .N>
20 <CHTYPE <INDEX ,SIDE-EFFECTS> FIX>>
23 (ELSE <SET KK (.N !.KK)> T)>>
26 (<AND <==? <NODE-TYPE <SET N <1 .KK>>> ,SEG-CODE>
27 <==? <STRUCTYP <RESULT-TYPE <SET N <1 <KIDS .N>>>>>
31 (ELSE <SET TEM <REFERENCE ()>>)>
33 <FUNCTION (NL "AUX" (N <1 .NL>))
34 #DECL ((NL) <LIST NODE> (N) NODE)
35 <COND (<==? <NODE-TYPE .N> ,SEG-CODE>
36 <SET TEM <SEG-BUILD-LIST <1 <KIDS .N>> .TEM <> <> <>>>)
38 <FREE-TEMP <SET T1 <GEN .N>> <>>
39 <COND (<AND <N==? .TEM .W> <N==? .TEM .SUGGEST>>
41 (ELSE <DEALLOCATE-TEMP .TEM>)>
47 <COND (<AND <EMPTY? <REST .NL>>
49 <COND (<TYPE? .W TEMP>
52 (<TYPE? .SUGGEST TEMP>
53 <USE-TEMP .SUGGEST LIST>
55 (ELSE <GEN-TEMP LIST>)>>>)>>
59 <COND (<==? <NODE-TYPE <SET N <1 .K>>> ,SEG-CODE>
60 <SET TEM <SEG-BUILD-LIST <1 <KIDS .N>> <REFERENCE ()> T T <>>>
65 <SET D1 <GEN .N DONT-CARE>>
73 <COND (<TYPE? .SUGGEST TEMP>
74 <USE-TEMP .SUGGEST LIST>
76 (ELSE <GEN-TEMP LIST>)>>>>)>
78 <FUNCTION (L "AUX" (N <1 .L>))
81 (<==? <NODE-TYPE .N> ,SEG-CODE>
84 <==? <STRUCTYP <RESULT-TYPE <SET N <1 <KIDS .N>>>>>
87 <SET D1 <GEN .N DONT-CARE>>
88 <COND (.OOPSF <EMPTY-LIST .D3 <SET TG1 <MAKE-TAG>> T>)>
89 <IEMIT `PUTREST .D3 .D1>
92 <EMPTY-LIST .D3 <SET TG1 <MAKE-TAG>> <>>
96 (ELSE <SET D3 <SEG-BUILD-LIST .N .D3 T <> <COND (.OOPSF .D2)>>>)>)
98 <FREE-TEMP <SET D1 <GEN .N DONT-CARE>> <>>
99 <IEMIT `CONS <ATOMCHK .D1> () = <SET D1 <GEN-TEMP LIST>>>
100 <COND (.OOPSF <EMPTY-LIST .D3 <SET TG1 <MAKE-TAG>> T>)>
101 <IEMIT `PUTREST .D3 .D1>
103 <BRANCH-TAG <SET TG2 <MAKE-TAG>>>
108 <COND (<N==? .D3 .D2> <FREE-TEMP .D3>)>
111 <COND (<N==? .D2 .D3> <FREE-TEMP .D3>)>
114 <DEFINE SEG-BUILD-LIST (NOD DAT FLG FST SMQ
115 "AUX" (TYP <RESULT-TYPE .NOD>) (TG2 <MAKE-TAG>)
116 (ITYP <ISTYPE? .TYP>)
117 (TPS <STRUCTYP .TYP>)
118 (ET <GET-ELE-TYPE .TYP ALL>)
119 (ML <MINL .TYP>) TG3 TG4
120 (TG1 <MAKE-TAG>) TEM D1 (D3 .DAT) FDAT)
122 <COND (<TYPE? .D3 TEMP> <USE-TEMP .D3 LIST>)>
123 <SET ET <ISTYPE-GOOD? .ET>>
124 <SET D1 <GEN .NOD <GEN-TEMP <>>>>
125 <COND (<OR .FST <NOT .FLG>>
127 <SET DAT <MOVE-ARG .DAT <GEN-TEMP <>>>>
128 <MT-TEST .D1 .TG1 .TPS .ITYP>)
129 (ELSE <SET DAT <GEN-TEMP>>)>
130 <NTH-DO .TPS .D1 <SET TEM <GEN-TEMP>> 1>
132 <IEMIT `CONS .TEM .D3 = <SET FDAT <GEN-TEMP LIST>>>
133 <SET-TEMP .DAT .FDAT>
135 (ELSE <SET-TEMP <SET FDAT <GEN-TEMP <>>> .DAT>)>
136 <COND (<OR .FST <NOT .FLG>> <SET D1 <1REST .D1 .TPS>>)>
137 <COND (<L=? .ML 1> <MT-TEST .D1 .TG1 .TPS .ITYP>)>
139 <COND (<NOT .TPS> (<TEMP-NAME .D1> TYPE VALUE LENGTH))
140 (<==? .TPS LIST> (<TEMP-NAME .D1> VALUE))
141 (ELSE (<TEMP-NAME .D1> VALUE LENGTH))>
142 (<TEMP-NAME .FDAT> VALUE)
143 !<COND (<AND <NOT .FLG> <TYPE? .D3 TEMP>>
144 ((<TEMP-NAME .D3> VALUE)))
147 <NTH-DO .TPS .D1 <SET TEM <GEN-TEMP>> 1>
148 <IEMIT `CONS .TEM <COND (.FLG ()) (ELSE .D3)> = .TEM>
149 <COND (.SMQ <EMPTY-LIST .FDAT <SET TG3 <MAKE-TAG>> T>)>
150 <IEMIT `PUTREST .FDAT .TEM>
152 <BRANCH-TAG <SET TG4 <MAKE-TAG>>>
154 <EMPTY-LIST .FDAT .TG4 <>>
155 <SET-TEMP .SMQ .TEM>)>
156 <SET-TEMP .FDAT .TEM>
159 <REST-N-JMP .D1 .TPS .TG2 .D1 .ITYP>
162 <COND (<AND .FLG .FST> (.DAT .FDAT <0? .ML>))
164 (ELSE <FREE-TEMP .FDAT> .DAT)>>
166 <DEFINE MT-TEST (D TG TP TYP)
168 <EMPTY-CHECK .TP .D .TYP T .TG>>
170 <DEFINE 1REST (D TP) #DECL ((TP) ATOM) <REST-DO .TP .D .D 1> .D>
172 <DEFINE REST-N-JMP (D TP TG D1 TYP)
173 <REST-DO .TP .D .D1 1>
174 <EMPTY-CHECK .TP .D .TYP <> .TG>