5 <USE "CODGEN" "COMCOD" "CACS" "CHKDCL" "COMPDEC" "COMTEM">
7 <DEFINE LENGTH?-GEN (N W
8 "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>)
9 "AUX" QDAT (STR <1 <KIDS .N>>) (FLG <>) (NUM <2 <KIDS .N>>)
10 (TYP <RESULT-TYPE .STR>) (TPS <STRUCTYP .TYP>)
11 (TYP1 <COND (<ISTYPE? .TYP>) (ELSE .TPS)>)
12 (FLS <==? .W FLUSHED>) (SDIR .DIR) (B3 <MAKE:TAG>) NK
15 <COND (<AND .FLS .BRANCH> .BRANCH)
16 (ELSE <MAKE:TAG>)>) SAC NAC STRD NUMD TEM T1
17 (TEMP? <==? .TPS TEMPLATE>) (RW .W))
18 #DECL ((N STR NUM) NODE (QDAT STRD NUMD) DATUM (SAC NAC) AC (NN) FIX
19 (TPS TYP1 B2 B3) ATOM (NK FLS DIR SDIR NOTF BRANCH) <OR FALSE ATOM>)
20 <SET W <GOODACS .N .W>>
21 <COND (<==? <NODE-TYPE .NUM> ,QUOTE-CODE>
23 <COND (<OR <L? <SET NN <NODE-NAME .NUM>> 0> <G? .NN 262144>>
24 <MESSAGE ERROR " ARG OUT OF RANGE LENGTH? " .NN>)>)
26 <AND .NOTF <SET DIR <NOT .DIR>>>
29 <SET STRD <GEN .STR <DATUM .TYP1 ANY-AC>>>
32 <PUT <SET NUMD <REG? FIX .W>>
34 <SET NAC <GETREG .NUMD>>>
35 <EMIT <INSTRUCTION `MOVSI <ACSYM .NAC> <- -1 .NN>>>)
37 <SET NUMD <GEN .NUM DONT-CARE>>
38 <COND (<TYPE? <DATVAL .NUMD> AC>
39 <EMIT <INSTRUCTION `MOVNS <ADDRSYM <SET NAC <DATVAL .NUMD>>>>>)
41 <EMIT <INSTRUCTION `MOVN
42 <ACSYM <SET NAC <GETREG .NUMD>>>
44 <RET-TMP-AC <DATVAL .NUMD> .NUMD>
45 <PUT .NUMD ,DATVAL .NAC>)>
46 <RET-TMP-AC <DATTYP .NUMD> .NUMD>
47 <PUT .NUMD ,DATTYP FIX>
48 <EMIT <INSTRUCTION `MOVSI <ACSYM .NAC> -1 (<ADDRSYM .NAC>)>>)>
53 <SET SAC <DATVAL .STRD>>
56 <EMIT <INSTRUCTION `JUMPE
58 <COND (.DIR .B2) (ELSE .B3)>>>
59 <EMIT <INSTRUCTION `HRRZ <ACSYM .SAC> (<ADDRSYM .SAC>)>>
60 <EMIT <INSTRUCTION `AOBJN <ACSYM .NAC> '.HERE!-OP!-PACKAGE -2>>
62 <COND (<AND .BRANCH .FLS>
63 <COND (<NOT .DIR> <BRANCH:TAG .B2> <LABEL:TAG .B3>)>
65 (<OR .NOTF <NOT <==? <NOT .BRANCH> <NOT .DIR>>>>
67 <COND (<AND .NOTF .DIR> <BRANCH:TAG .B3> <LABEL:TAG .B2>)>
68 <MOVE:ARG <REFERENCE .SDIR> .W>
75 <EMIT <INSTRUCTION `MOVEI <ACSYM .NAC> (<ADDRSYM .NAC>)>>
76 <SET W <MOVE:ARG .NUMD .W>>
80 <COND (<==? .NAC <DATVAL .W>> <RET-TMP-AC .NAC .NUMD>)>
81 <COND (<==? <DATTYP .NUMD> <DATTYP .W>>
82 <RET-TMP-AC <DATTYP .NUMD> .NUMD>)>
83 <RET-TMP-AC <MOVE:ARG <REFERENCE <>> .W>>
86 <EMIT <INSTRUCTION `MOVEI <ACSYM .NAC> (<ADDRSYM .NAC>)>>
87 <SET W <MOVE:ARG .NUMD .W>>
91 (<AND <N==? .TPS STRING> <N==? .TPS BYTES>
93 <OR .FLS .NOTF <N==? <NOT .BRANCH> <NOT .DIR>>>>
95 <SET STRD <GEN .STR DONT-CARE>>
96 <RET-TMP-AC <DATTYP .STRD> .STRD>)
97 (<SET STRD <GEN .STR <DATUM .TYP1 ANY-AC>>>)>
100 <SET QDAT <DATUM FIX ANY-AC>>
101 <COND (<TYPE? <DATVAL .STRD> AC>
102 <PUT .QDAT ,DATVAL <DATVAL .STRD>>)
103 (ELSE <PUT .QDAT ,DATVAL <GETREG .QDAT>>)>
104 <GET:TEMPLATE:LENGTH <ISTYPE? .TYP> .STRD .QDAT>
105 <EMIT <INSTRUCTION <COND (<COND (<AND .BRANCH .FLS> .DIR)
109 <ACSYM <DATVAL .QDAT>>
112 (<EMIT <INSTRUCTION <COND (<COND (<AND .BRANCH .FLS> .DIR)
116 <ACSYM <SET SAC <DATVAL .STRD>>>
119 <COND (<OR <==? .TPS VECTOR>
125 (<OR <==? .TPS STRING> <==? .TPS BYTES>>
126 <SET STRD <GEN .STR DONT-CARE>>
127 <RET-TMP-AC <DATVAL .STRD> .STRD>
128 <COND (<TYPE? <DATTYP .STRD> AC>
129 <SET STRD <DATUM FIX <SET NAC <DATTYP <SET NUMD .STRD>>>>>
131 <COND (<AND <TYPE? .W DATUM> <TYPE? <DATVAL .W> AC>>
132 <SGETREG <DATVAL .W> .STRD>)
133 (<ACRESIDUE .NAC> <GETREG .STRD>)
135 <PUT .STRD ,DATVAL .SAC>
136 <COND (<N==? .NAC .SAC>
137 <EMIT <INSTRUCTION `MOVEI <ACSYM .SAC> (<ADDRSYM .NAC>)>>
138 <RET-TMP-AC .NAC .NUMD>)
143 <EMIT <INSTRUCTION `MOVEI
145 (<ADDRSYM .NAC>)>>)>)
148 <COND (<AND <TYPE? .W DATUM> <TYPE? <DATVAL .W> AC>>
149 <SGETREG <DATVAL .W> <>>)
151 <EMIT <INSTRUCTION `HRRZ <ACSYM .SAC> !<ADDR:TYPE .STRD>>>
152 <RET-TMP-AC <DATTYP .STRD> .STRD>
153 <SET STRD <DATUM FIX .SAC>>
154 <PUT .SAC ,ACLINK (.STRD !<ACLINK .SAC>)>)>)
156 <SET STRD <GEN .STR DONT-CARE>>
157 <RET-TMP-AC <DATTYP .STRD> .STRD>
159 (<AND <TYPE? .W DATUM>
160 <TYPE? <DATVAL .STRD> AC>
161 <==? <DATVAL .W> <DATVAL .STRD>>>
163 <GET:TEMPLATE:LENGTH .STRD <SET SAC <DATVAL .STRD>>>)
166 `HLRES <ADDRSYM <SET SAC <DATVAL .STRD>>>>>)>)
169 <COND (<AND <TYPE? .W DATUM> <TYPE? <DATVAL .W> AC>>
170 <SGETREG <DATVAL .W> .STRD>)
171 (ELSE <GETREG .STRD>)>>
174 <COND (.TEMP? <GET:TEMPLATE:LENGTH <ISTYPE? .TYP> .STRD .SAC>)
175 (<EMIT <INSTRUCTION `HLRE <ACSYM .SAC> !<ADDR:VALUE .STRD>>>)>
176 <PUT .SAC ,ACPROT <>>
177 <PUT .STRD ,DATVAL .SAC>)>
178 <PUT .STRD ,DATTYP FIX>
180 <EMIT <INSTRUCTION `MOVNS <ADDRSYM .SAC>>>
181 <COND (<OR <==? .TPS VECTOR> <==? .TPS TUPLE>>
182 <EMIT <INSTRUCTION `ASH <ACSYM .SAC> -1>>)>)>)>
185 <SET NUMD <GEN .NUM DONT-CARE>>
186 <RET-TMP-AC <DATTYP .NUMD> .NUMD>
188 <PUT .NUMD ,DATTYP FIX>
189 <COND (<N==? .SAC <DATVAL .STRD>>
190 <COND (<ACLINK .SAC> <TOACV .STRD> <SET SAC <DATVAL .STRD>>)
192 <MOVE:VALUE <DATVAL .STRD> .SAC>
193 <PUT .SAC ,ACLINK (.STRD !<ACLINK .SAC>)>
194 <PUT .STRD ,DATVAL .SAC>)>)>
195 <IMCHK <COND (<COND (<AND .BRANCH .FLS> .DIR)
196 (<OR .NOTF <N==? <NOT .BRANCH> <NOT .DIR>>>
198 (ELSE <AND <SET FLG <=? .W .STRD>> .DIR>)>
200 (ELSE '(`CAMLE `CAILE ))>
204 <COND (<AND .BRANCH .FLS>
206 <OR .FLG <RET-TMP-AC .STRD>>)
207 (<OR .NOTF <N==? <NOT .BRANCH> <NOT .DIR>>>
208 <OR .FLG <RET-TMP-AC .STRD>>
211 <MOVE:ARG <REFERENCE .SDIR> .W>
216 <COND (<NOT .FLG> <BRANCH:TAG .B2>)>
217 <RET-TMP-AC <MOVE:ARG .STRD .W>>
222 <RET-TMP-AC <MOVE:ARG .STRD .W>>
225 <MOVE:ARG <REFERENCE <>> .W>
226 <LABEL:TAG .B3>)>)>)>