5 <USE "CODGEN" "COMCOD" "CACS" "CHKDCL" "COMPDEC">
9 "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>)
10 "AUX" (STR <2 <KIDS .N>>) (THING <1 <KIDS .N>>)
11 (TYP <RESULT-TYPE .STR>) (TPS <STRUCTYP .TYP>)
12 (TYP1 <COND (<ISTYPE? .TYP>) (ELSE .TPS)>)
13 (FLS <==? .W FLUSHED>) (SDIR .DIR)
14 (TTYP <RESULT-TYPE .THING>) (TAC <>)
15 (ETY <GET-ELE-TYPE .TYP ALL>)
16 (TWIN <TYPESAME .ETY .TTYP>)
18 <COND (<AND .FLS .BRANCH> .BRANCH) (ELSE <MAKE:TAG>)>)
19 SAC NAC STRD NUMD DEAD (TWOW <>) TEM TY DAC DCOD
20 (B3 <MAKE:TAG>) (RW .W) (FC <0? <MINL .TYP>>)
21 (LP <MAKE:TAG>) B4 (DEADV <>))
22 #DECL ((N STR THING) NODE (STRD NUMD) DATUM (DAC SAC NAC) AC (DCOD) FIX
23 (TPS TYP1 B2 B3 B4) ATOM (DEAD) <PRIMTYPE LIST>
24 (NK FLS DIR SDIR NOTF BRANCH) <OR FALSE ATOM>)
25 <SET W <GOODACS .N .W>>
26 <AND .NOTF <SET DIR <NOT .DIR>>>
27 <COND (<OR <==? .TPS STRING> <==? .TPS BYTES>> <SET TWOW T>)>
29 <COND (<TYPE? .W DATUM> <GOODACS .N .W>)
31 <OR <AND <==? <NODE-TYPE .STR> ,LVAL-CODE>
32 <==? <LENGTH <SET DEAD <TYPE-INFO .STR>>> 2>
37 (.TWOW <DATUM ANY-AC ANY-AC>)
38 (ELSE <DATUM .TYP1 ANY-AC>)>>
39 <COND (<AND <NOT <SIDE-EFFECTS .N>>
40 <NOT <MEMQ <NODE-TYPE .STR> ,SNODES>>
41 <MEMQ <NODE-TYPE .THING> ,SNODES>>
42 <SET STRD <GEN .STR .TEM>>
43 <SET NUMD <GEN .THING DONT-CARE>>)
47 <COND (<AND <NOT <==? <NODE-TYPE .STR> ,QUOTE-CODE>>
50 <GOODACS .THING <DATUM ANY-AC ANY-AC>>)
52 <SET STRD <GEN .STR .TEM>>)>
57 (<SET TY <ISTYPE? .ETY>>
58 <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE `O !<ADDR:TYPE .NUMD>>>
59 <EMIT <INSTRUCTION `CAIE `O <FORM TYPE-CODE!-OP!-PACKAGE .TY>>>
60 <BRANCH:TAG <COND (.DIR .B3) (ELSE .B2)>>
63 <EMIT <INSTRUCTION `HLRE
64 <ACSYM <SET SAC <GETREG <>>>>
68 <EMIT <INSTRUCTION `SUBM <ACSYM <DATVAL .STRD>> <ADDRSYM .SAC>>>
70 <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE
73 <COND (<SET TEM <ISTYPE? .TTYP>>
74 <EMIT <INSTRUCTION `CAIE
76 <FORM TYPE-CODE!-OP!-PACKAGE .TEM>>>)
78 <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE `O !<ADDR:TYPE .NUMD>>>
79 <EMIT <INSTRUCTION `CAIE `O (<ADDRSYM .SAC>)>>)>
80 <BRANCH:TAG <COND (.DIR .B3) (ELSE .B2)>>
84 <COND (<ISTYPE-GOOD? .TPS>
86 <PUT .STRD ,DATTYP .TPS>)>)>
87 <COND (<TYPE? <DATVAL .STRD> AC>
88 <PUT <SET SAC <DATVAL .STRD>> ,ACPROT T>)>
91 <PUT <SET NAC <DATVAL .NUMD>> ,ACPROT T>)>
92 <COND (<ASSIGNED? SAC> <MUNG-AC .SAC .STRD>)>
93 <AND <TYPE? <DATTYP .STRD> AC>
94 <MUNG-AC <DATTYP .STRD> .STRD>>
95 <COND (<AND <NOT <ISTYPE? .TTYP>>
99 <PUT <SET TAC <GETREG <>>> ,ACPROT T>
100 <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE
102 !<ADDR:TYPE .NUMD>>>)>
103 <COND (<ASSIGNED? SAC> <PUT .SAC ,ACPROT <>>)>
104 <COND (<NOT .TWOW> <PUT .NAC ,ACPROT <>>)>
105 <COND (<AND .BRANCH <NOT .FLS> .DIR <NOT .NOTF> <=? .W .STRD>>
109 <COND (<G=? <SET DCOD <MIN <DEFERN .ETY> <DEFERN .TTYP>>> 1>
110 <SET DAC <GETREG <>>>)>
112 <EMIT <INSTRUCTION `JUMPE
114 <COND (.DIR .B3) (ELSE .B2)>>>)>
116 <COND (<0? .DCOD> <SET DAC .SAC>)
118 <EMIT <INSTRUCTION `MOVE <ACSYM .DAC> 1 (<ADDRSYM .SAC>)>>)
120 <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE `O (<ADDRSYM .SAC>)>>
121 <EMIT <INSTRUCTION `MOVE <ACSYM .DAC> <ADDRSYM .SAC>>>
122 <EMIT '<`CAIN `O TDEFER!-OP!-PACKAGE>>
123 <EMIT <INSTRUCTION `MOVE <ACSYM .DAC> 1 (<ADDRSYM .DAC>)>>)>
129 <COND (.DIR .B2) (ELSE .B3)>
131 <EMIT <INSTRUCTION `HRRZ <ACSYM .SAC> (<ADDRSYM .SAC>)>>
132 <EMIT <INSTRUCTION `JUMPN <ACSYM .SAC> .LP>>)
135 <EMIT <INSTRUCTION `JUMPGE
137 <COND (.DIR .B3) (ELSE .B2)>>>)>
144 <COND (.DIR .B2) (ELSE .B3)>
146 <EMIT <INSTRUCTION `AOBJN <ACSYM .SAC> .LP>>)
149 <EMIT <INSTRUCTION `JUMPGE
151 <COND (.DIR .B3) (ELSE .B2)>>>)>
158 <COND (.DIR .B2) (ELSE .B3)>
160 <EMIT <INSTRUCTION `ADD <ACSYM .SAC> '[<2 (2)>]>>
161 <EMIT <INSTRUCTION `JUMPL <ACSYM .SAC> .LP>>)
163 <COND (<TYPE? <DATTYP .STRD> AC>
164 <COND (<AND <ACRESIDUE <SET SAC <DATTYP .STRD>>>
166 <EMIT <INSTRUCTION `MOVEI
167 <SET SAC <GETREG <>>>
168 (<ADDRSYM <DATTYP .STRD>>)>>)
171 <EMIT <INSTRUCTION `MOVEI <ACSYM .SAC> (<ADDRSYM .SAC>)>>)>)
173 <SET SAC <GETREG <>>>
174 <EMIT <INSTRUCTION `HRRZ <ACSYM .SAC> !<ADDR:TYPE .STRD>>>)>
177 <TYPE? <DATVAL .STRD> TEMP>
178 <SET STRD <TOACV .STRD>>>
179 <PUT .SAC ,ACPROT <>>
181 <EMIT <INSTRUCTION `JUMPE
183 <COND (.DIR .B3) (ELSE .B2)>>>)>
185 <EMIT <INSTRUCTION `ILDB `O !<ADDR:VALUE .STRD>>>
186 <IMCHK (`CAMN `CAIN ) `O <DATVAL .NUMD>>
187 <BRANCH:TAG <COND (.DIR .B2) (ELSE .B3)>>
188 <EMIT <INSTRUCTION `SOJG <ACSYM .SAC> .LP>>)
191 <COND (<TYPE? <DATTYP .STRD> AC>
192 <EMIT <INSTRUCTION `TRNN <ACSYM <SET SAC <DATTYP .STRD>>> -1>>
193 <BRANCH:TAG <COND (.DIR .B3) (ELSE .B2)>>)
195 <EMIT <INSTRUCTION `HRRZ `O !<ADDR:TYPE .STRD>>>
196 <EMIT <INSTRUCTION `JUMPE `O <COND (.DIR .B3) (ELSE .B2)>>>)>
197 <EMIT <INSTRUCTION `MOVE `O !<ADDR:VALUE .STRD>>>
198 <EMIT '<`ILDB `O `O >>
199 <IMCHK '(`CAMN `CAIN ) `O <DATVAL .NUMD>>
200 <BRANCH:TAG <COND (.DIR .B2) (ELSE .B3)>>
201 <EMIT <INSTRUCTION `IBP !<ADDR:VALUE .STRD>>>
202 <COND (<TYPE? <DATTYP .STRD> AC>
203 <EMIT <INSTRUCTION `SOJA <ACSYM .SAC> .LP>>)
205 <EMIT <INSTRUCTION `SOS !<ADDR:TYPE .STRD>>>
207 <AND .TAC <PUT .TAC ,ACPROT <>>>
210 <COND (<AND .BRANCH .FLS>
211 <COND (<NOT .DIR> <BRANCH:TAG .B2> <LABEL:TAG .B3>)
212 (ELSE <LABEL:TAG .B3>)>
214 (<OR .NOTF <NOT <==? <NOT .BRANCH> <NOT .DIR>>>>
216 <COND (<AND .NOTF .DIR> <BRANCH:TAG .B3>)>
218 <MOVE:ARG <REFERENCE .SDIR> .W>
223 <COND (<==? .B2 .BRANCH>
225 <SET W <MOVE:ARG .STRD .W>>)
229 <SET W <MOVE:ARG .STRD .W>>
235 <RET-TMP-AC <SET W <MOVE:ARG <REFERENCE <>> .W>>>
236 <COND (<TYPE? <DATTYP .STRD> AC>
237 <PUT <DATTYP .STRD> ,ACLINK (.STRD)>)>
238 <COND (<TYPE? <DATVAL .STRD> AC>
239 <PUT <DATVAL .STRD> ,ACLINK (.STRD)>)>
242 <SET W <MOVE:ARG .STRD .W>>)
244 <BRANCH:TAG <SET B4 <MAKE:TAG>>>
246 <SET W <MOVE:ARG .STRD .W>>
247 <LABEL:TAG .B4>)>)>)>
250 <DEFINE CHECK-VAL (OFFS VAC SAC TAC TTYP BR TWIN)
251 #DECL ((OFFS) FIX (SAC VAC) AC (TAC) <OR AC FALSE>)
253 <EMIT <INSTRUCTION `CAMN <ACSYM .VAC> .OFFS (<ADDRSYM .SAC>)>>
256 <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE
263 <COND (<SET TTYP <ISTYPE? .TTYP>>
264 <FORM TYPE-CODE!-OP!-PACKAGE .TTYP>)
265 (ELSE (<ADDRSYM .TAC>))>>>
266 <EMIT <INSTRUCTION `CAME <ACSYM .VAC> .OFFS (<ADDRSYM .SAC>)>>