3 <ENTRY BITLOG-GEN GETBITS-GEN PUTBITS-GEN BITS-GEN>
5 <USE "CACS" "CODGEN" "COMCOD" "COMPDEC" "CHKDCL">
7 <DEFINE BITLOG-GEN (N W
8 "AUX" (K <KIDS .N>) (REG <UPDATE-WHERE .N .W>) (FST <1 .K>)
9 (INS <LGINS <NODE-SUBR .N>>))
10 #DECL ((FST N) NODE (K) <LIST [REST NODE]> (REG) DATUM)
11 <COND (<==? <NODE-TYPE .FST> ,QUOTE-CODE>
14 <SET REG <GEN <1 .K> .REG>>
15 <RET-TMP-AC <DATTYP .REG> .REG>
18 <COND (<ISTYPE? <RESULT-TYPE .N>>) (ELSE WORD)>>
20 <FUNCTION (NN "AUX" (NXT <GEN .NN DONT-CARE>) TT)
21 #DECL ((NN) NODE (NXT) DATUM)
22 <COND (<TYPE? <DATVAL .REG> AC>)
23 (<TYPE? <SET TT <DATVAL .NXT>> AC>
24 <PUT .NXT ,DATVAL <DATVAL .REG>>
25 <PUT .REG ,DATVAL .TT>
26 <FIX-ACLINK .TT .REG .NXT>)
28 <PUT <SET TT <DATVAL .REG>> ,ACPROT T>
30 <IMCHK .INS <ACSYM .TT> <DATVAL .NXT> T>
37 <NTH '![(`AND `ANDI `ANDCMI )
41 <LENGTH <MEMQ .SUBR ,LSUBRS>>>>
43 <SETG LSUBRS ![,EQVB ,XORB ,ORB ,ANDB!]>
45 <DEFINE GETBITS-GEN (N W
46 "AUX" (WRDN <1 <KIDS .N>>) (BP <2 <KIDS .N>>) REG POS WDTH
47 BAC AC BPW WRD BPD TEM)
48 #DECL ((WRDN N BP) NODE (POS WDTH) FIX (WRD REG BPD) DATUM (AC BAC) AC
49 (BPW) <PRIMTYPE WORD>)
51 (<==? <NODE-TYPE .BP> ,QUOTE-CODE>
52 <SET WRD <GEN .WRDN DONT-CARE>>
53 <SET BPW <NODE-NAME .BP>>
54 <SET POS <CHTYPE <GETBITS .BPW #BITS *360600000000*> FIX>>
55 <SET WDTH <CHTYPE <GETBITS .BPW #BITS *300600000000*> FIX>>
57 (<AND <==? <+ .POS .WDTH> 36>
59 <TYPE? <DATVAL .WRD> AC>
60 <NOT <ACRESIDUE <SET AC <DATVAL .WRD>>>>
61 <OR <==? .W DONT-CARE>
62 <AND <TYPE? .W DATUM> <==? .AC <DATVAL .WRD>>>>>
63 <MUNG-AC .AC <SET REG .WRD>>
64 <EMIT <INSTRUCTION `LSH <ACSYM .AC> <- .POS>>>)
66 <PUT <SGETREG <SET AC <DATVAL <SET REG <REG? WORD .W T>>>> .REG>
69 <COND (<AND <==? .WDTH 18> ;"Could be half word hack."
71 <EMIT <INSTRUCTION `HRRZ
76 <EMIT <INSTRUCTION `HLRZ
81 <EMIT <INSTRUCTION `LDB
83 [<FORM <CHTYPE .BPW OPCODE!-OP!-PACKAGE>
84 !<ADDR:VALUE .WRD>>]>>)>
87 (<==? <NODE-TYPE .BP> ,BITS-CODE>
90 <COND (<SIDE-EFFECTS .BP> <DATUM WORD ANY-AC>)
93 <1 <SET TEM <RBITS-GEN .BP <DATUM BITS ANY-AC> .WRD>>>>
94 <PUT <SGETREG <SET AC <DATVAL <SET REG <REG? WORD .W T>>>> .REG>
98 <PUT <SET BAC <DATVAL .BPD>> ,ACPROT T>
100 <PUT .TEM 1 <1 <ADDR:VALUE .WRD>>>
101 <PUTREST .TEM <REST <ADDR:VALUE .WRD>>>
102 <EMIT <INSTRUCTION `LDB <ACSYM .AC> <ADDRSYM .BAC>>>
103 <PUT .BAC ,ACPROT <>>
107 (ELSE ;"Non constant byte pointer."
110 <COND (<SIDE-EFFECTS .BP> <DATUM WORD ANY-AC>)
112 <SET BPD <GEN .BP DONT-CARE>>
113 <PUT <SGETREG <SET AC <DATVAL <SET REG <REG? WORD .W T>>>> .REG>
116 <SET BPD <MOVE:ARG .BPD <DATUM BITS ANY-AC>>>
117 <PUT <SET BAC <DATVAL .BPD>> ,ACPROT T>
119 <EMIT <INSTRUCTION `HRRI <ACSYM .BAC> !<ADDR:VALUE .WRD>>>
120 <EMIT <INSTRUCTION `LDB <ACSYM .AC> <ADDRSYM .BAC>>>
121 <PUT .BAC ,ACPROT <>>
127 <DEFINE PUTBITS-GEN (N W
128 "AUX" (K <KIDS .N>) (SWRD <1 .K>) (BP <2 .K>) BAC POS WDTH
129 FLD BPW BPD SWRDD (FLG T) TEM NUM)
130 #DECL ((N SWRD BP) NODE (FLD BPD REG SWRDD) DATUM (AC BAC PAC) AC
131 (POS WDTH) FIX (BPW) <PRIMTYPE WORD> (NUM) <OR FALSE FIX>)
133 (<==? <NODE-TYPE .BP> ,QUOTE-CODE>
135 <CHTYPE <GETBITS <SET BPW <NODE-NAME .BP>> #BITS *360600000000*> FIX>>
136 <SET WDTH <CHTYPE <GETBITS .BPW #BITS *300600000000*> FIX>>
138 (<AND <==? <NODE-TYPE .SWRD> ,QUOTE-CODE>
139 <0? <CHTYPE <NODE-NAME .SWRD> FIX>>>
140 <SET SWRDD <GEN <3 .K> <REG? <RESULT-TYPE .SWRD> .W>>>
141 <MUNG-AC <DATVAL .SWRDD> .SWRDD>
142 <COND (<L? <+ .POS .WDTH> 36>
143 <IMCHK '(`AND `ANDI )
144 <ACSYM <DATVAL .SWRDD>>
145 <REFERENCE:ADR <GETBITS -1 <BITS .WDTH>>>>)>
146 <EMIT <INSTRUCTION `LSH <ACSYM <DATVAL .SWRDD>> .POS>>)
150 <REG? <COND (<ISTYPE? <RESULT-TYPE .SWRD>>) (ELSE TUPLE)> .W>>>
151 <MUNG-AC <DATVAL .SWRDD> .SWRDD>
157 <COND (<AND <SET NUM <ZERQ .K>> <OR <L=? .NUM 0> <G=? .NUM 262143>>>
158 <EMIT <INSTRUCTION <COND (<0? .NUM> `HLLZS ) (ELSE `HLLOS )>
159 <ADDRSYM <DATVAL .SWRDD>>>>)
160 (ELSE <PCLOB .SWRDD '(`HRR `HRRI ) <3 .K>>)>)
162 <COND (<AND <SET NUM <ZERQ .K>> <OR <L=? .NUM 0> <G=? .NUM 262143>>>
163 <EMIT <INSTRUCTION <COND (<0? .NUM> `HRRZS ) (ELSE `HRROS )>
164 <ADDRSYM <DATVAL .SWRDD>>>>)
165 (ELSE <PCLOB .SWRDD '(`HRL `HRLI ) <3 .K>>)>
167 (<AND <OR <AND <L? .POS 18> <L=? <+ .POS .WDTH> 18>> <G? .POS 18>>
169 <OR <0? .NUM> <L? .WDTH <POPWR2 <+ .NUM 1>>>>>
170 <EMIT <INSTRUCTION <COND (<0? .NUM>
171 <COND (<L? .POS 18> `ANDCMI ) (ELSE `TLZ )>)
173 <COND (<L? .POS 18> `IORI ) (ELSE `TLO )>)>
174 <ACSYM <DATVAL .SWRDD>>
175 <LSH <LSH -1 <- .WDTH 36>>
176 <COND (<L? .POS 18> .POS)
177 (ELSE <- .POS 18>)>>>>)
179 <SET FLD <GEN <3 .K> <DATUM WORD ANY-AC>>>
180 <PUT <DATVAL .FLD> ,ACPROT T>
182 <PUT <DATVAL .SWRDD> ,ACPROT T>
183 <EMIT <INSTRUCTION `DPB
184 <ACSYM <DATVAL .FLD>>
185 [<FORM <CHTYPE .BPW OPCODE!-OP!-PACKAGE>
186 <ADDRSYM <DATVAL .SWRDD>>>]>>
187 <PUT <DATVAL .FLD> ,ACPROT <>>
188 <PUT <DATVAL .SWRDD> ,ACPROT <>>
189 <RET-TMP-AC .FLD>)>)>)
191 <COND (<NOT <AND <NOT <SIDE-EFFECTS .N>> <MEMQ <NODE-TYPE .SWRD> ,SNODES>>>
194 <REG? <COND (<ISTYPE? <RESULT-TYPE .SWRD>>) (ELSE TUPLE)>
198 <COND (<==? <NODE-TYPE .BP> ,BITS-CODE>
203 <COND (<ASSIGNED? SWRDD> .SWRDD)
204 (ELSE ,NO-DATUM)>>>>)
205 (ELSE <GEN .BP DONT-CARE>)>>
207 <COND (<SET NUM <ZERQ .K>>
208 <SET FLD <MOVE:ARG <REFERENCE .NUM> <DATUM WORD ANY-AC>>>)
209 (ELSE <SET FLD <GEN <3 .K> <DATUM WORD ANY-AC>>>)>
211 <PUT .FLD ,DATTYP WORD>
212 <COND (<NOT <ASSIGNED? SWRDD>>
215 <REG? <COND (<ISTYPE? <RESULT-TYPE .SWRD>>) (ELSE TUPLE)>
217 <COND (<NOT <TYPE? <DATVAL .SWRDD> AC>>
221 <REG? <COND (<ISTYPE? <RESULT-TYPE .SWRD>>) (ELSE TUPLE)>
223 <PUT <DATVAL .SWRDD> ,ACPROT T>
225 <PUT <DATVAL .FLD> ,ACPROT T>
227 <PUT <SET BAC <DATVAL .BPD>> ,ACPROT T>
229 <PUT <2 .TEM> 1 <ADDRSYM <DATVAL .SWRDD>>>
230 <PUTREST <2 .TEM> ()>)>
231 <MUNG-AC <DATVAL .SWRDD> .SWRDD>
234 <EMIT <INSTRUCTION `HRRI <ACSYM .BAC> <ADDRSYM <DATVAL .SWRDD>>>>)>
235 <EMIT <INSTRUCTION `DPB <ACSYM <DATVAL .FLD>> <ADDRSYM .BAC>>>
236 <PUT .BAC ,ACPROT <>>
237 <PUT <DATVAL .SWRDD> ,ACPROT <>>
238 <PUT <DATVAL .FLD> ,ACPROT <>>
241 <MOVE:ARG .SWRDD .W>>
243 <DEFINE ZERQ (L "AUX" NUM)
244 #DECL ((L) <LIST [REST NODE]>)
245 <COND (<==? <LENGTH .L> 2>)
246 (<AND <==? <NODE-TYPE <SET NUM <3 .L>>> ,QUOTE-CODE>
247 <==? <PRIMTYPE <SET NUM <NODE-NAME .NUM>>> WORD>
248 <OR <AND <0? <SET NUM <CHTYPE .NUM FIX>>> 0>
249 <AND <POPWR2 <+ .NUM 1>> .NUM>>>)>>
251 <DEFINE PCLOB (DEST INS SRC "AUX" SRCD)
252 #DECL ((DEST SRCD) DATUM (SRC) NODE)
253 <SET SRCD <GEN .SRC DONT-CARE>>
255 <PUT <DATVAL .DEST> ,ACPROT T>
256 <IMCHK .INS <ACSYM <DATVAL .DEST>> <DATVAL .SRCD>>
257 <PUT <DATVAL .DEST> ,ACPROT <>>
260 <DEFINE BITS-GEN (N W) <1 <RBITS-GEN .N .W DONT-CARE>>>
262 <DEFINE RBITS-GEN (N W ADDR
263 "AUX" (K <KIDS .N>) (WDTHN <1 .K>) WDTH POS TEM
264 (REG <REG? WORD .W>) POSD (FLG T))
265 #DECL ((POS N WDTHN) NODE (REG WDTH POSD) DATUM (K) <LIST [REST NODE]>)
266 <COND (<==? <LENGTH .K> 2> <SET POS <2 .K>>)>
268 (<==? <NODE-TYPE .WDTHN> ,QUOTE-CODE>
269 <SET TEM <MAKE-PTR .ADDR T <NODE-NAME .WDTHN>>>)
270 (<OR <NOT <ASSIGNED? POS>>
271 <==? <NODE-TYPE .POS> ,QUOTE-CODE>>
275 <COND (<ASSIGNED? POS> <NODE-NAME .POS>) (ELSE 0)>>>
279 <SET WDTH <GEN .WDTHN .REG>>
280 <MUNG-AC <DATVAL .REG> .REG>
281 <EMIT <INSTRUCTION `LSH <ACSYM <DATVAL .REG>> 24>>
282 <COND (<TYPE? .ADDR DATUM>
283 <EMIT <SET TEM <INSTRUCTION `HRRI <ACSYM <DATVAL .REG>> 0>>>
284 <SET TEM <REST .TEM 2>>)
285 (ELSE <SET TEM '(0)>)>)>
286 <SET POSD <GEN .POS <DATUM WORD ANY-AC>>>
287 <PUT <DATVAL .POSD> ,ACPROT T>
288 <COND (<NOT <ASSIGNED? WDTH>>
289 <SET WDTH <DATUM WORD ANY-AC>>
290 <PUT .WDTH ,DATVAL <GETREG .WDTH>>
291 <EMIT <INSTRUCTION `MOVE <ACSYM <DATVAL .WDTH>> .TEM>>
292 <SET TEM <REST <1 .TEM>>>)
293 (ELSE <TOACV .WDTH>)>
294 <PUT <DATVAL .WDTH> ,ACPROT T>
295 <EMIT <INSTRUCTION `DPB
296 <ACSYM <DATVAL .POSD>>
297 [<FORM (<COND (.FLG 123264) (ELSE 98688)>)
298 <ADDRSYM <DATVAL .WDTH>>>]>>
299 <PUT <DATVAL .WDTH> ,ACPROT <>>
300 <PUT <DATVAL .POSD> ,ACPROT <>>
302 <COND (<TYPE? <DATTYP .WDTH> AC>
303 <RET-TMP-AC <DATTYP .WDTH> .WDTH>)>
304 <PUT .WDTH ,DATTYP BITS>
305 [<MOVE:ARG .WDTH .W> .TEM]>
307 <DEFINE MAKE-PTR (AD W-P CNST "AUX" (BP <BITS 6 <COND (.W-P 24) (ELSE 30)>>))
309 <COND (<TYPE? .AD DATUM>
310 [<FORM (<GETBITS <PUTBITS 0 .BP .CNST> <BITS 18 18>>) HERE>])
312 [<FORM (<GETBITS <PUTBITS 0 .BP .CNST> <BITS 18 18>>) 0>])>>