3 <ENTRY TEMPLATE-NTH TEMPLATE-PUT GET:TEMPLATE:LENGTH>
5 <USE "CODGEN" "CACS" "CHKDCL" "COMCOD" "COMPDEC">
7 <DEFINE TEMPLATE-NTH (NOD WHERE TYP TPS NK NNUM STRN NUMN
8 "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>) EX1 EX2
9 "AUX" RLEN COMPLFORM (DIR1 .DIR)
10 (FLS <==? .WHERE FLUSHED>)
11 (B2 <COND (.BRANCH .BRANCH) (ELSE <MAKE:TAG>)>)
12 (TTYPE <GET <SET TYP <ISTYPE? .TYP>> TEMPLATE-DATA>)
13 DEST (NORMUSE <1 .TTYPE>) (RESTUSE <2 .TTYPE>)
14 (RX <GEN .STRN <DATUM .TYP ANY-AC>>) RUSE LENCOMB PC
15 TYPER PCA BITR IDX AC1 AC2)
16 #DECL ((B2 TYPER) ATOM (AC1 AC2) <PRIMTYPE WORD>
17 (NNUM RLEN LENCOMB PC PCA IDX) FIX (DEST) <LIST <PRIMTYPE WORD>>
18 (RX RUSE) DATUM (TTYPE) <VECTOR [2 LIST] [2 FIX] ANY [2 FIX]>
19 (RESTUSE NORMUSE) <LIST [REST LIST]> (COMPLFORM) <LIST ATOM [4 FIX]>
21 <AND .NOTF <SET DIR <NOT .DIR>>>
22 <COND (<G? .NNUM <3 .TTYPE>>
23 <COND (<0? <4 .TTYPE>> <MESSAGE ERROR TEMPLATE-OVERFLOW!-ERRORS>)>
24 <SET RLEN <+ 1 <MOD <- .NNUM 1 <3 .TTYPE>> <4 .TTYPE>>>>
25 <SET COMPLFORM <NTH .RESTUSE .RLEN>>
32 <COND (<G? <- </ <- .NNUM <3 .TTYPE>> <4 .TTYPE>> 1> 0>
33 <- </ <- .NNUM <3 .TTYPE>> <4 .TTYPE>> 1>)
36 (ELSE <SET COMPLFORM <NTH .NORMUSE .NNUM>>)>
38 <GOODACS .NOD <COND (.FLS DONT-CARE) (ELSE .WHERE)>>>
39 <SET TYPER <1 .COMPLFORM>>
40 <SET PCA <3 .COMPLFORM>>
41 <SET PC <5 .COMPLFORM>>
42 <SET LENCOMB <2 .COMPLFORM>>
43 <SET DEST (<ADDRSYM <DATVAL .RX>>)>
44 <COND (<AND <NOT <==? .LENCOMB 72>>
46 <NOT <==? .LENCOMB 36>>>
47 <COND (<==? <DATVAL .RUSE> ANY-AC>
48 <PUT .RUSE ,DATVAL <GETREG .RUSE>>)
49 (ELSE <SGETREG <DATVAL .RUSE> .RUSE>)>
50 <SET AC2 <ACSYM <DATVAL .RUSE>>>)>
52 <SET IDX <+ <4 .COMPLFORM> 1>>
53 <MUNG-AC <DATVAL .RX> .RX>
54 <EMIT <INSTRUCTION `LDB `O [<FORM (74816) 1 .DEST>]>>
55 <EMIT <INSTRUCTION `SUB <ACSYM <DATVAL .RX>> `O >>)
56 (ELSE <SET IDX <- <4 .COMPLFORM> <6 .TTYPE>>>)>
57 <COND (<OR <AND <NOT <==? .LENCOMB 72>> <G? .LENCOMB 36>>
58 <AND <==? .LENCOMB 36> <NOT <0? .PCA>>>>
59 <COND (<==? <DATTYP .RUSE> ANY-AC>
60 <PUT .RUSE ,DATTYP <GETREG .RUSE>>)
61 (ELSE <SGETREG <DATTYP .RUSE> .RUSE>)>
62 <SET AC1 <ACSYM <DATTYP .RUSE>>>)>
64 <SET DEST (<ADDRSYM <DATVAL .RX>>)>
68 <COND (<AND .BRANCH .NOTF>
69 <SET WHERE <MOVE:ARG <REFERENCE .DIR1> .RUSE>>)
71 <PUT .RUSE ,DATTYP <OFFPTR .IDX .RX .TYP>>
72 <PUT .RUSE ,DATVAL <OFFPTR .IDX .RX .TYP>>
73 <SET WHERE <MOVE:ARG .RUSE .WHERE>>)>)>
75 <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE
79 <EMIT <INSTRUCTION <COND (.DIR `CAIE ) (ELSE `CAIN )>
81 '<TYPE-CODE!-OP!-PACKAGE FALSE>>>
82 <BRANCH:TAG .BRANCH>)>
83 <COND (<OR .FLS <AND .BRANCH .NOTF>> <RET-TMP-AC .RX>)>)
85 <COND (<==? .LENCOMB 36>
86 <EMIT <INSTRUCTION `MOVE .AC2 .IDX .DEST>>
88 <EMIT <INSTRUCTION `HRLI .AC1 '<TYPE-CODE!-OP!-PACKAGE STRING>>>
89 <EMIT <INSTRUCTION `HRRI .AC1 .PCA>>)
91 <PUT .RUSE ,DATTYP .TYPER>
92 <COND (<==? .PC 36> <EMIT <INSTRUCTION `HLR .AC2 .IDX .DEST>>)
93 (ELSE <EMIT <INSTRUCTION `HRR .AC2 .IDX .DEST>>)>
95 <EMIT <INSTRUCTION `HRLI
97 <COND (<==? .TYPER UVECTOR> <- .PCA>)
98 (ELSE <* -2 .PCA>)>>>)>)
101 <EMIT <INSTRUCTION `MOVE .AC2 .IDX .DEST>>
102 <EMIT <INSTRUCTION `HLR .AC1 <+ .IDX 1> .DEST>>)
104 <EMIT <INSTRUCTION `MOVE .AC2 <+ .IDX 1> .DEST>>
105 <EMIT <INSTRUCTION `HRR .AC1 .IDX .DEST>>)>
106 <EMIT <INSTRUCTION `HRLI .AC1 '<TYPE-CODE!-OP!-PACKAGE STRING>>>
109 <PUT .RUSE ,DATTYP .TYPER>
110 <PUT .RUSE ,DATVAL <OFFPTR <- .IDX 1> .RX .TYP>>)
112 <PUT .RUSE ,DATTYP .TYPER>
113 <COND (<AND <==? .TYPER FALSE> .FLS>)
114 (<EMIT <INSTRUCTION <COND (<==? .PC 36>
115 <COND (<==? .TYPER FIX> `HLRE )
116 (<==? .TYPER FLOAT> `HLLZ )
119 <COND (<==? .TYPER FIX> `HRRE )
120 (<==? .TYPER FLOAT> `HRLZ )
125 <COND (<==? .TYPER FALSE>
126 <COND (<NOT .FLS> <SET WHERE <MOVE:ARG .RUSE .WHERE>>)>
127 <COND (<AND .BRANCH <NOT .DIR>> <BRANCH:TAG .BRANCH>)>)>)
129 <EMIT <INSTRUCTION `MOVE `O .IDX .DEST>>
131 <BITS 1 <COND (<G? .PC 18> <- .PC 19>) (ELSE <- .PC 1>)>>>
133 <PUTBITS #WORD *000000000000* .BITR #WORD *777777777777*>>
135 <COND (<OR <AND <NOT .DIR> <NOT .BRANCH> <NOT .FLS>>
136 <AND <NOT .DIR1> <NOT .FLS>>>
137 <RET-TMP-AC <MOVE:ARG <REFERENCE <>> .RUSE>>)>
138 <COND (<G? .PC 18> <EMIT <INSTRUCTION `TLNN `O .BITR>>)
139 (ELSE <EMIT <INSTRUCTION `TRNN `O .BITR>>)>
140 <SET BITR <MAKE:TAG>>
141 <COND (<NOT .DIR> <BRANCH:TAG .B2>)
142 (ELSE <BRANCH:TAG .BITR>)>
143 <COND (<OR <AND <NOT .DIR> <NOT .BRANCH> <NOT .FLS>>
144 <AND .DIR1 <NOT .FLS>>>
145 <MOVE:ARG <REFERENCE T> .RUSE>)>
146 <COND (<AND .DIR .BRANCH> <BRANCH:TAG .B2>)>
148 <COND (<NOT .BRANCH> <LABEL:TAG .B2>)>)
150 <PUT .RUSE ,DATTYP .TYPER>
151 <EMIT <INSTRUCTION `LDB
153 <BYTE <- .PC .LENCOMB> .LENCOMB .IDX .DEST>>>)>
154 <COND (<NOT <OR <NOT <0? .PCA>>
159 <COND (<AND <NOT <==? .LENCOMB 72>> <NOT <==? .TYPER FALSE>>>
160 <MOVE:ARG .RUSE .WHERE>)
165 <DEFINE TEMPLATE-PUT (NOD WHERE TYP TPS NK NNUM SNOD NNOD VNOD
167 "AUX" CK YDAT XDAT RLEN DEST COMPLFORM XTP VDAT
168 (TTYPE <GET <SET TYP <ISTYPE? .TYP>> TEMPLATE-DATA>)
169 (NORMUSE <1 .TTYPE>) (RESTUSE <2 .TTYPE>)
170 (RX <GEN .SNOD <GOODACS .NOD .WHERE>>) LENCOMB PC
171 TYPER PCA BITR IDX AC1 AC2 TT)
172 #DECL ((PCA NNUM PC IDX LENCOMB RLEN) FIX (TYPER) ATOM
173 (AC1 AC2) <PRIMTYPE WORD> (DEST) <LIST <PRIMTYPE WORD>>
174 (RX XDAT YDAT VDAT) DATUM (RESTUSE NORMUSE) <LIST [REST LIST]>
175 (TTYPE) <VECTOR [2 LIST] [2 FIX] ANY [2 FIX]>
176 (COMPLFORM) <LIST ATOM [4 FIX]> (SNOD VNOD NOD) NODE)
177 <COND (<G? .NNUM <3 .TTYPE>>
178 <COND (<0? <4 .TTYPE>> <MESSAGE ERROR TEMPLATE-OVERFLOW!-ERRORS>)>
179 <SET RLEN <+ 1 <MOD <- .NNUM 1 <3 .TTYPE>> <4 .TTYPE>>>>
180 <SET COMPLFORM <NTH .RESTUSE .RLEN>>
187 <COND (<G? <- </ <- .NNUM <3 .TTYPE>> <4 .TTYPE>> 1> 0>
188 <- </ <- .NNUM <3 .TTYPE>> <4 .TTYPE>> 1>)
191 (ELSE <SET COMPLFORM <NTH .NORMUSE .NNUM>>)>
192 <SET LENCOMB <2 .COMPLFORM>>
193 <SET TYPER <1 .COMPLFORM>>
194 <SET PCA <3 .COMPLFORM>>
195 <SET PC <5 .COMPLFORM>>
197 <SET DEST (<ADDRSYM <DATVAL .RX>>)>
198 <COND (<SET CK <5 .TTYPE>>
199 <SET IDX <+ <4 .COMPLFORM> 1>>
200 <COND (<AND <5 .TTYPE> <N==? .WHERE FLUSHED>>
201 <PUT <DATVAL .RX> ,ACPROT T>
202 <SET YDAT <DATUM .TYP ANY-AC>>
203 <PUT .YDAT ,DATVAL <GETREG .YDAT>>
204 <EMIT <INSTRUCTION `MOVE
205 <ACSYM <DATVAL .YDAT>>
206 <ADDRSYM <DATVAL .RX>>>>
207 <PUT <DATVAL .RX> ,ACPROT <>>)>)
208 (ELSE <SET IDX <- <4 .COMPLFORM> <6 .TTYPE>>>)>
209 <SET XTP <ISTYPE? <RESULT-TYPE .VNOD>>>
214 <DATUM <COND (<NOT <ISTYPE-GOOD? .XTP>> ANY-AC) (ELSE .XTP)>
217 (<AND <NOT <==? .LENCOMB 72>>
218 <SET XTP <ISTYPE? <RESULT-TYPE .VNOD>>>>
219 <COND (<NOT <OR <==? .TYPER .XTP> <1? .LENCOMB>>>
220 <MESSAGE ERROR TEMPLATE-TYPE-ERROR-PUT!-ERRORS>)>)
223 <NOT <==? .TYPER ANY>>
224 <NOT <==? <RESULT-TYPE .VNOD> .TYPER>>>
225 <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE `O !<ADDR:TYPE .VDAT>>>
226 <EMIT <INSTRUCTION `CAIE
228 <FORM TYPE-CODE!-OP!-PACKAGE .TYPER>>>
229 <BRANCH:TAG |COMPER >)>)>)>
231 <SET DEST (<ADDRSYM <DATVAL .RX>>)>
232 <COND (<AND .CK <NOT <1? .LENCOMB>>>
233 <MUNG-AC <DATVAL .RX> .RX>
234 <EMIT <INSTRUCTION `LDB `O [<FORM (74816) 1 .DEST>]>>
235 <EMIT <INSTRUCTION `SUB <ACSYM <DATVAL .RX>> `O >>)>
236 <COND (<NOT <1? .LENCOMB>> <SET AC2 <ACSYM <DATVAL .VDAT>>>)>
240 <EMIT <INSTRUCTION `MOVEM <ACSYM <DATTYP .VDAT>> .IDX .DEST>>
241 <RET-TMP-AC <DATTYP .VDAT> .VDAT>
242 <EMIT <INSTRUCTION `MOVEM .AC2 <+ .IDX 1> .DEST>>)
244 <COND (<==? .LENCOMB 36>
246 <EMIT `HRRZ `O !<ADDR:TYPE .VDAT>>
247 <EMIT <INSTRUCTION `CAIE <ACSYM <DATTYP .VDAT>> .PCA>>
248 <BRANCH:TAG |COMPER >)>
249 <EMIT <INSTRUCTION `MOVEM .AC2 .IDX .DEST>>)
252 <EMIT <INSTRUCTION `HLRZ `O <ADDRSYM <DATVAL .VDAT>>>>
253 <EMIT <INSTRUCTION `CAIE
255 <COND (<==? .TYPER UVECTOR> <- .PCA>)
256 (ELSE <* -2 .PCA>)>>>
257 <BRANCH:TAG |COMPER >)>
258 <EMIT <INSTRUCTION <COND (<==? .PC 36> `HRLM ) (ELSE `HRRM )>
265 <EMIT <INSTRUCTION `MOVEM .AC2 .IDX .DEST>>
266 <EMIT <INSTRUCTION `HRLM
267 <ACSYM <DATTYP .VDAT>>
270 <RET-TMP-AC <DATTYP .VDAT> .VDAT>)
272 <EMIT <INSTRUCTION `MOVEM .AC2 <+ .IDX 1> .DEST>>
273 <EMIT <INSTRUCTION `HRRM <ACSYM <DATTYP .VDAT>> .IDX .DEST>>
274 <RET-TMP-AC <DATTYP .VDAT> .VDAT>)>
275 <RET-TMP-AC <DATTYP .VDAT> .VDAT>)
277 <EMIT <INSTRUCTION `MOVEM .AC2 .IDX .DEST>>)
279 <EMIT <INSTRUCTION <COND (<==? .PC 36>
280 <COND (<==? .TYPER FLOAT> `HLLM ) (ELSE `HRLM )>)
282 <COND (<==? .TYPER FLOAT> `HLRM )
288 <SET BITR <BITS 1 <- .PC 1>>>
290 <PUTBITS #WORD *000000000000* .BITR #WORD *777777777777*>>
291 <SET VDAT <GEN .VNOD DONT-CARE>>
293 <SET DEST (<ADDRSYM <DATVAL .RX>>)>
295 <MUNG-AC <DATVAL .RX> .RX>
296 <EMIT <INSTRUCTION `LDB `O [<FORM (74816) 1 .DEST>]>>
297 <EMIT <INSTRUCTION `SUB <ACSYM <DATVAL .RX>> `O >>)>
299 <SET XDAT <DATUM FIX ANY-AC>>
300 <PUT <DATVAL .RX> ,ACPROT T>
301 <PUT .XDAT ,DATVAL <GETREG .XDAT>>
302 <PUT <DATVAL .RX> ,ACPROT <>>
303 <SET TT <ACSYM <DATVAL .XDAT>>>)
304 (ELSE <RET-TMP-AC .VDAT> <SET TT 0>)>
305 <EMIT <INSTRUCTION `MOVE .TT [.BITR]>>
307 <EMIT <INSTRUCTION <COND (<==? .XTP FALSE> `ANDCAM ) (ELSE `IORM )>
312 <D:B:TAG <SET BITR <MAKE:TAG>> .VDAT T <RESULT-TYPE .VNOD>>
314 <EMIT <INSTRUCTION `ANDCAM .TT .IDX .DEST>>
318 <EMIT <INSTRUCTION `IORM .TT .IDX .DEST>>)>)
320 <EMIT <INSTRUCTION `DPB
322 <BYTE <- .PC .LENCOMB> .LENCOMB .IDX .DEST>>>)>
323 <COND (<NOT <1? .LENCOMB>> <RET-TMP-AC .VDAT>)>
324 <COND (<NOT <5 .TTYPE>> <MOVE:ARG .RX .WHERE>)
325 (<N==? .WHERE FLUSHED>
327 <MOVE:ARG .YDAT .WHERE>)
328 (ELSE <MOVE:ARG .RX .WHERE>)>>
330 "ROUTINE TO FIND THE LENGTH OF A TEMPLATE"
332 <DEFINE GET:TEMPLATE:LENGTH (NM DAT NDAT "AUX" (TD <GET .NM TEMPLATE-DATA>))
333 #DECL ((NM) ATOM (TD) <OR FALSE <VECTOR [2 LIST] [5 ANY]>>
334 (NDAT) <OR <DATUM ANY AC> AC>)
336 <MESSAGE INCONSISTENCY "TEMPLATE DATA NOT AVAIABLE">)>
339 <MESSAGE WARNING "ASKING LENGTH OF CONSTANT TEMPLATE">
340 <EMIT <INSTRUCTION `MOVEI
341 <ACSYM <COND (<TYPE? .NDAT DATUM> <DATVAL .NDAT>)
345 <EMIT <INSTRUCTION `MOVE
346 <ACSYM <COND (<TYPE? .NDAT DATUM> <DATVAL .NDAT>)
349 <COND (<TYPE? .DAT DATUM> <DATVAL .DAT>)>>>>
350 <EMIT <INSTRUCTION `HRRZ
351 <ACSYM <COND (<TYPE? .NDAT DATUM> <DATVAL .NDAT>)
353 (<ADDRSYM <COND (<TYPE? .NDAT DATUM>
356 <COND (<EMPTY? <2 .TD>> 0) (ELSE -1)>>>)>>
358 <DEFINE BYTE (BOUND SIZE "TUPLE" LOC)
359 [<FORM (<+ <* .BOUND 4096> <* .SIZE 64>>) !.LOC>]>