5 <USE "CACS" "CODGEN" "COMCOD" "COMPDEC" "CHKDCL">
7 <DEFINE LIST-BUILD (NOD W
8 "AUX" (K <KIDS .NOD>) (KK ()) N TEM TT T1 D1 D2 D3
10 #DECL ((K KK) <LIST [REST NODE]> (N NOD) NODE)
15 <COND (<AND <G=? <LENGTH .N> <CHTYPE <INDEX ,SIDE-EFFECTS>
19 (ELSE <SET KK (.N !.KK)> T)>>
21 <COND (<AND <==? <NODE-TYPE <SET N <1 .KK>>> ,SEG-CODE>
22 <==? <STRUCTYP <RESULT-TYPE <SET N <1 <KIDS .N>>>>> LIST>>
25 <COND (<EMPTY? <REST .KK>> .W)
26 (ELSE <DATUM LIST ,AC-E>)>>>
28 (ELSE <SET TEM <REFERENCE ()>>)>
30 <FUNCTION (N "AUX" (COD <DEFERN <RESULT-TYPE .N>>))
31 #DECL ((N) NODE (COD) FIX)
32 <COND (<==? <NODE-TYPE .N> ,SEG-CODE>
34 <SEG-BUILD-LIST <1 <KIDS .N>> .TEM <> <> <>>>)
36 <SET T1 <GEN .N <DATUM ,AC-C ,AC-D>>>
37 <SET TEM <MOVE:ARG .TEM <DATUM LIST ,AC-E>>>
41 <EMIT <INSTRUCTION `PUSHJ
43 <COND (<0? .COD> |C1CONS )
45 <SET TEM <FUNCTION:VALUE T>>)>>
49 <COND (<==? <NODE-TYPE <SET N <1 .K>>> ,SEG-CODE>
50 <SET TEM <SEG-BUILD-LIST <1 <KIDS .N>> <REFERENCE ()> T T <>>>
55 <SET D1 <GEN .N <DATUM ,AC-C ,AC-D>>>
58 <EMIT <INSTRUCTION `MOVEI `E* 0>>
64 <COND (<0? <DEFERN <RESULT-TYPE .N>>> |C1CONS )
66 <SET D2 <DATUM LIST ,AC-B>>
67 <SET D3 <DATUM LIST ,AC-B>>
68 <PUT ,AC-B ,ACLINK (.D2)>
70 <PUT ,AC-B ,ACLINK (.D3)>)>
72 <FUNCTION (L "AUX" (N <1 .L>))
75 (<==? <NODE-TYPE .N> ,SEG-CODE>
77 (<AND <==? <STRUCTYP <RESULT-TYPE <SET N <1 <KIDS .N>>>>> LIST>
79 <SET D1 <GEN .N <DATUM LIST ANY-AC>>>
82 <PUT <DATVAL .D1> ,ACPROT T>
83 <EMIT <INSTRUCTION `SKIPE
84 <ACSYM <SET TEM <GETREG <>>>>
86 <PUT <DATVAL .D1> ,ACPROT <>>)>
87 <EMIT <INSTRUCTION `HRRM
92 <EMIT <INSTRUCTION `SKIPN <ADDRSYM .TEM>>>
93 <COND (<TYPE? <DATVAL .D2> AC>
102 !<ADDR:VALUE .D2>>>)>)>
104 (ELSE <SET D3 <SEG-BUILD-LIST .N .D3 T <> <COND (.OOPSF .D2)>>>)>)
106 <SET D1 <GEN .N <DATUM ,AC-C ,AC-D>>>
108 <SET D1 <MOVE:ARG .D1 <DATUM ,AC-C ,AC-D>>>
109 <EMIT '<`MOVEI `E* >>
115 <COND (<0? <DEFERN <RESULT-TYPE .N>>> |C1CONS )
117 <COND (.OOPSF <EMIT <INSTRUCTION `SKIPE `C* !<ADDR:VALUE .D3>>>)>
118 <EMIT <INSTRUCTION `HRRM `B* `@ !<ADDR:VALUE .D3>>>
119 <EMIT <INSTRUCTION `MOVEM `B* !<ADDR:VALUE .D3>>>
122 <EMIT <INSTRUCTION `MOVEM `B* !<ADDR:VALUE .D2>>>)>)>>
127 <DEFINE SEG-BUILD-LIST (NOD DAT FLG FST SMQ
128 "AUX" (TYP <RESULT-TYPE .NOD>) (TG2 <MAKE:TAG>)
129 (ITYP <ISTYPE? .TYP>) (TPS <STRUCTYP .TYP>)
130 (ET <GET-ELE-TYPE .TYP ALL>) (DF <DEFERN .ET>)
131 (ML <MINL .TYP>) (TG1 <MAKE:TAG>) TEM D1 D3 FDAT
133 #DECL ((NOD) NODE (DAT D1 D2 FDAT) DATUM (SMQ) <OR DATUM FALSE>)
134 <SET ET <ISTYPE-GOOD? .ET>>
137 <DATUM <COND (<ISTYPE-GOOD? .ITYP> .ITYP)
138 (<ISTYPE-GOOD? .TPS> .TPS)
141 <COND (<ISTYPE-GOOD? .TPS> <DATTYP-FLUSH .D1> <PUT .D1 ,DATTYP .TPS>)>
142 <COND (<OR .FST <NOT .FLG>>
147 <COND (.FST ,AC-B) (ELSE ,AC-E)>>>>
150 <SET FDAT <DATUM LIST <DATVAL .DAT>>>
152 <PUT ,AC-B ,ACLINK (.FDAT)>
153 <PUT <DATVAL .D1> ,ACLINK (.D1)>
154 <COND (<TYPE? <DATTYP .D1> AC>
155 <PUT <DATTYP .D1> ,ACLINK (.D1)>)>)>
156 <MT-TEST .D1 .TG1 .TPS>)>
158 <OFFPTR <COND (<==? .TPS UVECTOR> -1) (ELSE 0)> .D1 .TPS>>
159 <SET D3 <DATUM <COND (.ET) (ELSE .TEM)> .TEM>>
160 <SET D3 <MOVE:ARG .D3 <DATUM ,AC-C ,AC-D> T>>
161 <COND (<AND .FLG .FST> <RET-TMP-AC .FDAT>)
163 <SET DAT <MOVE:ARG .DAT <DATUM LIST ,AC-E>>>
167 <AND .FST <EMIT '<`MOVEI `E* >>>
168 <EMIT <INSTRUCTION `PUSHJ
170 <COND (<0? .DF> |C1CONS ) (ELSE |CICONS )>>>
171 <COND (<AND .FST <0? .ML>>
172 <EMIT <INSTRUCTION `MOVEM `B* !<ADDR:VALUE .DAT>>>)>)>
173 <COND (<OR <NOT .FST> <NOT <0? .ML>>>
174 <SET FDAT <DATUM LIST ,AC-B>>
175 <PUT ,AC-B ,ACLINK (.FDAT)>)>
176 <COND (<OR .FST <NOT .FLG>> <SET D1 <1REST .D1 .TPS>>)>
177 <COND (<OR <NOT .FST> <NOT <0? .ML>>>
178 <SET DAT <MOVE:ARG .FDAT <DATUM LIST ,AC-E> T>>)>
182 <PUT <DATVAL .D1> ,ACLINK (.D1)>
183 <COND (<TYPE? <DATTYP .D1> AC> <PUT <DATTYP .D1> ,ACLINK (.D1)>)>
184 <PUT ,AC-B ,ACLINK (.FDAT)>
185 <COND (<L=? .ML 1> <MT-TEST .D1 .TG1 .TPS>)>
186 <SET D4 <DATUM !.D1>>
188 <SET TEM <OFFPTR <COND (<==? .TPS UVECTOR> -1) (ELSE 0)> .D1 .TPS>>
190 <MOVE:ARG <DATUM <COND (.ET) (ELSE .TEM)> .TEM>
195 <COND (.FLG <EMIT '<`MOVEI `E* >>)
196 (ELSE <EMIT <INSTRUCTION `HRRZ `E* `@ !<ADDR:VALUE .FDAT>>>)>
198 <EMIT <INSTRUCTION `PUSHJ
200 <COND (<0? .DF> |C1CONS ) (ELSE |CICONS )>>>
201 <COND (.SMQ <EMIT <INSTRUCTION `SKIPE `C* !<ADDR:VALUE .FDAT>>>)>
202 <EMIT <INSTRUCTION `HRRM `B* `@ !<ADDR:VALUE .FDAT>>>
203 '<EMIT <INSTRUCTION `MOVEM `B* !<ADDR:VALUE .FDAT>>>
206 <EMIT <INSTRUCTION `MOVEM `B* !<ADDR:VALUE .SMQ>>>)>
207 <REST-N-JMP .D1 .TPS .TG2 .D4>
208 <COND (.FLG <SET FDAT <DATUM LIST ,AC-B>> <PUT ,AC-B ,ACLINK (.FDAT)>)
209 (ELSE <SET DAT <MOVE:ARG .DAT <DATUM LIST ,AC-E>>>)>
211 <COND (<AND .FLG .FST> (.DAT .FDAT <0? .ML>)) (.FLG .FDAT) (ELSE .DAT)>>
213 <DEFINE MT-TEST (D TG TP) #DECL ((TP) ATOM (D) DATUM)
215 <COND (<==? .TP LIST> <EMIT <INSTRUCTION `JUMPE <ACSYM <DATVAL .D>> .TG>>)
216 (ELSE <EMIT <INSTRUCTION `JUMPGE <ACSYM <DATVAL .D>> .TG>>)>>
220 <DATUM <COND (<ISTYPE-GOOD? .TP> .TP) (ELSE ANY-AC)>
222 #DECL ((TP) ATOM (D DD) DATUM (AC) AC)
223 <COND (<==? .TP LIST>
224 <PUT .DD ,DATVAL <SET AC <GETREG .DD>>>
225 <EMIT <INSTRUCTION `HRRZ <ACSYM .AC> `@ !<ADDR:VALUE .D>>>
228 <SET DD <MOVE:ARG .D .DD>>
229 <EMIT <INSTRUCTION `ADD
231 <COND (<==? .TP UVECTOR> '[<1 (1)>])
232 (ELSE '[<2 (2)>])>>>)>
235 <DEFINE REST-N-JMP (D TP TG D1 "AUX" (AC <DATVAL .D1>))
236 #DECL ((D D1) DATUM (TP) ATOM (AC) AC)
237 <COND (<==? .TP LIST>
238 <EMIT <INSTRUCTION `HRRZ <ACSYM .AC> `@ !<ADDR:VALUE .D>>>
239 <EMIT <INSTRUCTION `JUMPN <ACSYM .AC> .TG>>
241 <PUT .AC ,ACLINK (.D1 !<ACLINK .AC>)>)
243 <EMIT <INSTRUCTION `MOVE <ACSYM .AC> !<ADDR:VALUE .D>>>
244 <COND (<TYPE? <DATTYP .D1> AC>
245 <EMIT <INSTRUCTION `MOVE
248 <PUT <DATTYP .D1> ,ACLINK (.D1 !<ACLINK
251 <PUT .AC ,ACLINK (.D1 !<ACLINK .AC>)>
252 <COND (<==? .TP UVECTOR>
253 <EMIT <INSTRUCTION `AOBJN <ACSYM .AC> .TG>>)
255 <EMIT <INSTRUCTION `ADD <ACSYM .AC> '[<2 (2)>]>>
256 <EMIT <INSTRUCTION `JUMPL <ACSYM .AC> .TG>>)>)>