5 <USE "CODGEN" "COMCOD" "CACS" "CHKDCL" "COMPDEC">
8 "ILIST, IVECTOR, IUVECTOR AND ISTRING."
10 <DEFINE ISTRUC-GEN (N W
11 "AUX" (NAM <NODE-NAME .N>) (K <KIDS .N>)
12 (NT <NODE-TYPE .N>) (BYTSZ <>))
13 #DECL ((N NUM EL) NODE)
14 <COND (<==? .NAM ITUPLE>
17 <==? .NT ,ISTRUC-CODE>
20 <ISTYPE? <RESULT-TYPE .N>>
23 <PROG ((STK (0 !.STK)))
24 #DECL ((STK) <SPECIAL LIST>)
25 <COND (<==? .NAM IBYTES>
28 <APPLY <NTH ,IERS <LENGTH <MEMQ .NAM ,NAMVEC>>>
31 <==? .NT ,ISTRUC-CODE>
34 <ISTYPE? <RESULT-TYPE .N>>
37 <DEFINE ILIST-GEN (N W GENR NUMN EL TYP BYTSZ "AUX" NUM START TEM END ELD)
38 #DECL ((N NUMN EL) NODE (NUM VALUE) DATUM (START END) ATOM)
39 <SET NUM <GEN .NUMN DONT-CARE>>
40 <EMIT <INSTRUCTION `PUSH `P* !<ADDR:VALUE .NUM>>>
42 <STACK:ARGUMENT <REFERENCE ()>>
43 <STACK:ARGUMENT <REFERENCE ()>>
46 <COND (.GENR <SET ELD <GEN .EL DONT-CARE>>)>
48 <LABEL:TAG <SET START <MAKE:TAG>>>
49 <EMIT '<`SOSGE `(P) >>
50 <BRANCH:TAG <SET END <MAKE:TAG>>>
51 <RET-TMP-AC <COND (.GENR <DOEVS .ELD <DATUM ,AC-C ,AC-D>>)
52 (ELSE <GEN .EL <DATUM ,AC-C ,AC-D>>)>>
55 <EMIT '<`PUSHJ `P* |CICONS >>
56 <EMIT '<`SKIPE `(TP) >>
57 <EMIT '<`HRRM `B* `@ `(TP) >>
58 <EMIT '<`MOVEM `B* `(TP) >>
59 <EMIT '<`SKIPN `(TP) -2>>
60 <EMIT '<`MOVEM `B* `(TP) -2>>
63 <EMIT '<`MOVE `B* `(TP) -2>>
64 <EMIT '<`SUB `TP* [<4 (4)>]>>
65 <EMIT '<`SUB `P* [<1 (1)>]>>
66 <AND .GENR <RET-TMP-AC .ELD>>
67 <SET TEM <DATUM .TYP ,AC-B>>
71 <DEFINE IVEC-GEN (N W GENR NUMN EL TYP BYTSZ
72 "AUX" NT (UV <==? .TYP UVECTOR>) START END TEM (ETY <>) ADS
73 ACS ANAC ATAG DAT AC OFPT ELD TTEM)
74 #DECL ((N NUMN EL) NODE (NT) FIX (DAT TEM) DATUM (AC) AC (OFPT) OFFPTR)
76 <RET-TMP-AC <GEN .NUMN <DATUM FIX ,AC-A>>>
77 <COND (.UV <EMIT '<`MOVEI `O* |IBLOCK >>)
78 (ELSE <EMIT '<`MOVEI `O* |IBLOK1 >>)>
80 <EMIT '<`PUSHJ `P* |RCALL >>
83 <==? <NODE-TYPE .EL> ,QUOTE-CODE>
84 <==? <NODE-NAME .EL> #LOSE *000000000000*>>
85 <MOVE:ARG <FUNCTION:VALUE T> .W>)
87 <OR <==? <SET NT <NODE-TYPE .EL>> ,QUOTE-CODE>
91 <==? .NT ,GVAL-CODE>>>
92 <SET DAT <DATUM .TYP ,AC-B>>
93 <SGETREG <DATVAL .DAT> .DAT>
97 <COND (<AND .UV <SET ETY <ISTYPE? <RESULT-TYPE .EL>>>>
98 <DATUM .ETY <GETREG <>>>)
100 <EMIT <INSTRUCTION `MOVE <SET ACS <ACSYM <SET AC <GETREG <>>>>> `B >>
101 <SET ADS <ADDRSYM .AC>>
102 <COND (<==? <NODE-TYPE .NUMN> ,QUOTE-CODE>
103 <OR <G? <CHTYPE <NODE-NAME .NUMN> FIX> 0>
104 <MESSAGE ERROR "BAD ARG TO " <NODE-NAME .N>>>)
105 (ELSE <EMIT <INSTRUCTION `JUMPGE .ACS <SET END <MAKE:TAG>>>>)>
106 <LABEL:TAG <SET START <MAKE:TAG>>>
108 <SET OFPT <OFFPTR <COND (.UV -1) (ELSE 0)> <DATUM .TYP .AC> .TYP>>
109 <MOVE:ARG .TEM <DATUM <COND (.ETY) (.UV WORD) (ELSE .OFPT)> .OFPT>>
110 <AND <TYPE? <DATVAL .TEM> AC> <MUNG-AC <DATVAL .TEM> .TEM>>
111 <AND <TYPE? <DATTYP .TEM> AC> <MUNG-AC <DATTYP .TEM> .TEM>>
112 <COND (.UV <EMIT <INSTRUCTION `AOBJN .ACS .START>>)
114 <EMIT <INSTRUCTION `ADD .ACS '[<2 (2)>]>>
115 <EMIT <INSTRUCTION `JUMPL .ACS .START>>)>
116 <AND <ASSIGNED? END> <LABEL:TAG .END>>
118 <EMIT <INSTRUCTION `MOVEI
120 <FORM TYPE-CODE!-OP!-PACKAGE .ETY>>>
121 <EMIT <INSTRUCTION PUTYP!-OP!-PACKAGE `O* (.ADS)>>)
123 <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE `O* !<ADDR:TYPE .TEM>>>
124 <EMIT <INSTRUCTION PUTYP!-OP!-PACKAGE `O* (.ADS)>>)>
129 <COND (<==? <NODE-TYPE .NUMN> ,QUOTE-CODE>
130 <OR <G? <CHTYPE <NODE-NAME .NUMN> FIX> 0>
131 <MESSAGE ERROR "BAD ARG TO " <NODE-NAME .N>>>)
132 (ELSE <EMIT <INSTRUCTION `JUMPGE `B* <SET END <MAKE:TAG>>>>)>
133 <SET ETY <ISTYPE? <RESULT-TYPE .EL>>>
134 <COND (<AND .UV .CAREFUL <NOT .ETY>>
135 <EMIT <INSTRUCTION `PUSH `P* '[0]>>
137 <STACK:ARGUMENT <DATUM .TYP ,AC-B>>
138 <STACK:ARGUMENT <DATUM .TYP ,AC-B>>
140 <COND (<AND .ETY .UV>
141 <COND (<N==? <NODE-TYPE .NUMN> ,QUOTE-CODE>
142 <EMIT '<`HLRE `O* `B >>
143 <EMIT '<`SUB `B* `O* >>)>
144 <EMIT <INSTRUCTION `MOVEI
146 <FORM TYPE-CODE!-OP!-PACKAGE .ETY>>>
147 <EMIT <INSTRUCTION PUTYP!-OP!-PACKAGE
149 <COND (<==? <NODE-TYPE .NUMN> ,QUOTE-CODE>
153 <COND (.GENR <SET ELD <GEN .EL DONT-CARE>> <REGSTO T>)>
154 <LABEL:TAG <SET START <MAKE:TAG>>>
156 <COND (<AND .UV .ETY> <DATUM .ETY ANY-AC>)
158 (ELSE <DATUM ANY-AC ANY-AC>)>>
159 <SET TEM <COND (.GENR <DOEVS .ELD .TTEM>) (ELSE <GEN .EL .TTEM>)>>
160 <AND <TYPE? <DATVAL .TEM> AC> <MUNG-AC <DATVAL .TEM> .TEM>>
161 <AND <TYPE? <DATTYP .TEM> AC> <MUNG-AC <DATTYP .TEM> .TEM>>
162 <EMIT <INSTRUCTION `MOVE <SET ACS <ACSYM <SET AC <GETREG <>>>>> `(TP) >>
163 <COND (<AND .UV <NOT .ETY>>
164 <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE `O* !<ADDR:TYPE .TEM>>>
166 <EMIT <INSTRUCTION `SKIPE '`(P) >>
167 <BRANCH:TAG <SET ATAG <MAKE:TAG>>>)>
168 <COND (<==? <NODE-TYPE .NUMN> ,QUOTE-CODE>
169 <EMIT <INSTRUCTION PUTYP!-OP!-PACKAGE
175 <EMIT <INSTRUCTION `HLRE
176 <ACSYM <SET ANAC <GETREG <>>>>
179 <EMIT <INSTRUCTION `SUBM .ACS <ADDRSYM .ANAC>>>
180 <EMIT <INSTRUCTION PUTYP!-OP!-PACKAGE
182 (<ADDRSYM .ANAC>)>>)>
184 <EMIT <INSTRUCTION `MOVEM `O* '`(P) >>
186 <EMIT <INSTRUCTION `CAIE `O* `@ '`(P) >>
187 <BRANCH:TAG |COMPER >)>)>
188 <SET OFPT <OFFPTR <COND (.UV -1) (ELSE 0)> <DATUM .TYP .AC> .TYP>>
190 <MOVE:ARG .TEM <DATUM <COND (.UV WORD) (ELSE .OFPT)> .OFPT>>
191 <EMIT <INSTRUCTION `ADD .ACS <COND (.UV '[<1 (1)>]) (ELSE '[<2 (2)>])>>>
192 <EMIT <INSTRUCTION `MOVEM .ACS '`(TP) >>
193 <EMIT <INSTRUCTION `JUMPL .ACS .START>>
196 <SET TEM <DATUM <COND (<ISTYPE? <RESULT-TYPE .N>>) (ELSE ,AC-A)> ,AC-B>>
197 <EMIT <INSTRUCTION `MOVE <ACSYM <CHTYPE <DATVAL .TEM> AC>> -2 '`(TP) >>
198 <EMIT <INSTRUCTION `SUB `TP* '[<4 (4)>]>>
199 <COND (<AND .UV .CAREFUL <NOT .ETY>>
200 <EMIT <INSTRUCTION `SUB `P* '[<1 (1)>]>>)>
201 <AND <ASSIGNED? END> <LABEL:TAG .END>>
202 <MOVE:ARG .TEM .W>)>>
205 #DECL ((D VALUE) DATUM)
209 <MOVE:ARG <FUNCTION:VALUE T> .W>>
211 <DEFINE ISTR-GEN (N W GENR NUMN EL TYP BYTSZ
212 "AUX" RES NK TN NN TT ACS OAC TEM BP START END ETY DAT
213 (SOB <==? <NODE-SUBR .N> ,ISTRING>) ELD TTEM
214 (OT <COND (.SOB CHARACTER) (ELSE FIX)>)
215 (NT <COND (.SOB STRING) (ELSE BYTES)>) (SIZ 7) SIZD)
216 #DECL ((N NUMN EL) NODE (TN SIZ) FIX (RES DAT SIZD TEM) DATUM (TT) AC
217 (NN) <PRIMTYPE WORD> (BYTSZ) <OR FALSE NODE>
218 (BP) <FORM ANY <LIST ANY>>)
220 <COND (<==? <NODE-TYPE .BYTSZ> ,QUOTE-CODE>
221 <SET SIZ <NODE-NAME .BYTSZ>>)
222 (ELSE <SET SIZD <GEN .BYTSZ <DATUM FIX ANY-AC>>>)>)>
224 <COND (<==? <NODE-TYPE .NUMN> ,QUOTE-CODE>
227 <AND <OR <L? <SET TN <NODE-NAME .NUMN>> 0> <G? .TN 262143>>
228 <MESSAGE ERROR "BAD ARG TO ISTRING/IBYTES ">>
229 <COND (<ASSIGNED? SIZD>
230 <EMIT '<`MOVEI `A* 36>>
231 <EMIT <INSTRUCTION `IDIV `A* !<ADDR:VALUE .SIZD>>>
232 <EMIT <INSTRUCTION `MOVEI `O* .TN>>
233 <EMIT '<`ADDI `O* (`A ) -1>>
234 <EMIT '<`IDIVM `O* `A >>)
236 <EMIT <INSTRUCTION `MOVEI
238 </ <+ .TN </ 36 .SIZ> -1> </ 36 .SIZ>>>>)>)
241 <SET TEM <GEN .NUMN <DATUM FIX ,AC-A>>>
246 <COND (<NOT <ASSIGNED? SIZD>>
247 <EMIT '<`PUSH `P* `A >>
248 <EMIT <INSTRUCTION `ADDI `A* <- </ 36 .SIZ> 1>>>
249 <EMIT <INSTRUCTION `IDIVI `A* </ 36 .SIZ>>>)
251 <EMIT '<`PUSH `P* `A >>
252 <EMIT '<`MOVEI `A* 36>>
253 <EMIT <INSTRUCTION `IDIV `A* !<ADDR:VALUE .SIZD>>>
254 <EMIT <INSTRUCTION `MOVE `O* (`P )>>
255 <EMIT '<`ADDI `O* (`A ) -1>>
256 <EMIT '<`IDIVM `O* `A >>)>)>
257 <EMIT '<`MOVEI `O* |IBLOCK >>
258 <EMIT '<`PUSHJ `P* |RCALL >>
259 <SET RES <DATUM UVECTOR ,AC-B>>
264 (<AND <NOT .GENR> <==? <NODE-TYPE .EL> ,QUOTE-CODE> <NOT <ASSIGNED? SIZD>>>
265 <COND (<NOT <0? <CHTYPE <SET NN <NODE-NAME .EL>> FIX>>>
267 <EMIT <INSTRUCTION `JUMPGE `B* <SET END <MAKE:TAG>>>>>
268 <SET NN <WOFBYTE .SIZ <CHTYPE .NN FIX>>>
269 <SET DAT <DATUM FIX FIX>>
270 <PUT .DAT ,DATVAL <GETREG .DAT>>
271 <EMIT <INSTRUCTION `MOVE <SET ACS <ACSYM <DATVAL .DAT>>> `B >>
272 <EMIT <INSTRUCTION `MOVE <SET OAC <ACSYM <GETREG <>>>> [.NN]>>
273 <LABEL:TAG <SET START <MAKE:TAG>>>
274 <EMIT <INSTRUCTION `MOVEM
276 (<ADDRSYM <CHTYPE <DATVAL .DAT> AC>>)>>
277 <EMIT <INSTRUCTION `AOBJN .ACS .START>>
279 <MUNG-AC <DATVAL .DAT>>)>)
283 <EMIT <INSTRUCTION `JUMPGE `B* <SET END <MAKE:TAG>>>>>
284 <RET-TMP-AC <STACK:ARGUMENT .RES>>
285 <COND (.NK <EMIT <INSTRUCTION `PUSH `P* [.TN]>>)
286 (ELSE <EMIT '<`PUSH `P* `(P) >>)>
287 <EMIT <INSTRUCTION `PUSH
290 <FORM (<COND (<NOT <ASSIGNED? SIZD>>
291 <ORB #WORD *000000440000*
293 (ELSE #WORD *000000440000*)>)
295 <MAPF <> ,ADD:STACK '(2 PSLOT PSLOT)>
296 <COND (<ASSIGNED? SIZD>
299 <EMIT <INSTRUCTION `IDIV !<ADDR:VALUE .SIZD>>>
301 <EMIT <INSTRUCTION `IOR `A* !<ADDR:VALUE .SIZD>>>
303 <EMIT '<`DPB `A* [<(#WORD *000000300600*) `(P) >]>>
305 <EMIT '<`HRRM `A* `(TP) -1>>
307 <EMIT '<`SKIPG `(P) -1>>
308 <BRANCH:TAG <SET END <MAKE:TAG>>>)>)>
309 <COND (.GENR <SET ELD <GEN .EL DONT-CARE>> <REGSTO T>)>
310 <LABEL:TAG <SET START <MAKE:TAG>>>
311 <SET ETY <ISTYPE? <RESULT-TYPE .EL>>>
313 <COND (<AND .CAREFUL <NOT .ETY>> <DATUM ANY-AC ANY-AC>)
314 (ELSE <DATUM .OT ANY-AC>)>>
315 <SET TEM <COND (.GENR <DOEVS .ELD .TTEM>) (ELSE <GEN .EL .TTEM>)>>
316 <COND (<AND .CAREFUL <NOT .ETY>>
317 <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE `O* !<ADDR:TYPE .TEM>>>
318 <EMIT <INSTRUCTION `CAIE `O* <FORM TYPE-CODE!-OP!-PACKAGE .OT>>>
319 <BRANCH:TAG |COMPER >)>
320 <EMIT <INSTRUCTION `HRRZ <ACSYM <SET TT <GETREG <>>>> '`(TP) >>
321 <PUT <2 .BP> 1 <ADDRSYM .TT>>
322 <EMIT <INSTRUCTION `IDPB <ACSYM <CHTYPE <DATVAL .TEM> AC>> '`(P) >>
323 <MUNG-AC <DATVAL .TEM> .TEM>
324 <AND <TYPE? <DATTYP .TEM> AC> <MUNG-AC <DATTYP .TEM> .TEM>>
327 <EMIT '<`SOSE `(P) -1>>
329 <COND (<ASSIGNED? END> <LABEL:TAG .END>)>
330 <EMIT '<`MOVE `B* `(TP) >>
331 <EMIT '<`HRL `B* `(TP) -1>>
332 <EMIT '<`SUB `TP* [<2 (2)>]>>
333 <EMIT '<`SUB `P* [<2 (2)>]>>
334 <SGETREG <DATVAL .RES> .RES>)>
337 <EMIT <INSTRUCTION `MOVE
340 (<FORM TYPE-CODE!-OP!-PACKAGE .NT>)>]>>)
342 <AND <ASSIGNED? END> <LABEL:TAG .END>>
343 <EMIT '<`POP `P* `A >>
344 <EMIT <INSTRUCTION `HRLI `A* <FORM TYPE-CODE!-OP!-PACKAGE .NT>>>)>
345 <COND (<NOT <ASSIGNED? SIZD>>
346 <EMIT <INSTRUCTION `HRLI
348 <CHTYPE <ORB <LSH .SIZ 6> <LSH <MOD 36 .SIZ> 12>>
350 <EMIT '<`SUBI `B* 1>>
351 <MOVE:ARG <FUNCTION:VALUE T> .W>>
353 <DEFINE ITUPLE-GEN (N W GENR NUMN EL TYP BYTSZ
354 "AUX" (START <MAKE:TAG>) (END <MAKE:TAG>) NX NT TEM
355 (NTEM <DATUM FIX ,AC-D>) (DOFLG <>) (ONEFLG <>)
356 (SFLG <GOOD-TUPLE .N>) ELD TTEM NW)
357 #DECL ((NT) FIX (NTEM TEM) DATUM (START END) ATOM (NUMN N EL) NODE
358 (DOFLG) <OR FIX ATOM FALSE>)
360 <OR <TYPE-OK? <RESULT-TYPE .NUMN> FIX>
361 <MESSAGE ERROR "BAD ARG TO ITUPLE" .N>>
362 <COND (<==? <NODE-TYPE .NUMN> ,QUOTE-CODE>
363 <COND (<L? <SET DOFLG <NODE-NAME .NUMN>> 0>
364 <MESSAGE ERROR "BAD-ARG TO ITUPLE" .N>)>)>
366 (<AND .SFLG <0? .DOFLG>> <ADD:STACK 2>)
369 <==? <NODE-TYPE .EL> ,QUOTE-CODE>
370 <==? <NODE-NAME .EL> #LOSE *000000000000*>>
371 <COND (.DOFLG <EMIT <INSTRUCTION `MOVEI `A* <* .DOFLG 2>>>)
374 <AND .CAREFUL <EMIT <INSTRUCTION `JUMPL `D* |COMPER >>>
375 <EMIT <INSTRUCTION `MOVEI `A* (<ADDRSYM <CHTYPE <DATVAL .NTEM> AC>>)>>
376 <EMIT <INSTRUCTION `ASH `A* 1>>
377 <EMIT <INSTRUCTION `PUSH `P* <ADDRSYM <CHTYPE <DATVAL .NTEM> AC>>>>
378 <EMIT <INSTRUCTION `JUMPE <ACSYM <CHTYPE <DATVAL .NTEM> AC>> .END>>
381 <EMIT '<`PUSHJ `P* |TPALOC >>
382 <COND (<SET NX <GOOD-TUPLE .N>> <ADD:STACK <+ <CHTYPE .NX FIX> 2>>)
383 (ELSE <ADD:STACK PSTACK>)>
386 <OR <==? <SET NT <NODE-TYPE .EL>> ,QUOTE-CODE>
388 <==? .NT ,FLVAL-CODE>
389 <==? .NT ,FGVAL-CODE>
390 <==? .NT ,GVAL-CODE>>>
394 <EMIT <INSTRUCTION `JUMPL
395 <ACSYM <CHTYPE <DATVAL .NTEM> AC>>
397 <SET TEM <GEN .EL <DATUM ANY-AC ANY-AC>>>
398 <COND (<NOT .DOFLG> <TOACV .NTEM> <ADD:STACK PSLOT> <ADD:STACK PSTACK>)>
400 <COND (<==? .DOFLG 1> <SET ONEFLG T>)
401 (<EMIT <INSTRUCTION `PUSH `P* <VECTOR <- .DOFLG 1>>>>)>)
403 <EMIT <INSTRUCTION `PUSH `P* <ADDRSYM <CHTYPE <DATVAL .NTEM> AC>>>>
404 <EMIT <INSTRUCTION `PUSH `P* <ADDRSYM <CHTYPE <DATVAL .NTEM> AC>>>>)>
406 <EMIT <INSTRUCTION `JUMPE <ACSYM <CHTYPE <DATVAL .NTEM> AC>> .END>>)>
408 <EMIT <INSTRUCTION `PUSH `TP* <ADDRSYM <CHTYPE <DATTYP .TEM> AC>>>>
409 <EMIT <INSTRUCTION `PUSH `TP* <ADDRSYM <CHTYPE <DATVAL .TEM> AC>>>>
411 <EMIT '<`SOSG -1 `(P) >>
412 <EMIT <INSTRUCTION `JRST .END>>
416 <COND (<AND .DOFLG .ONEFLG>)
418 <EMIT '<INTGO!-OP!-PACKAGE>>
419 <EMIT <INSTRUCTION `PUSH `TP* -1 `(TP) >>
420 <EMIT <INSTRUCTION `PUSH `TP* -1 `(TP) >>
421 <EMIT <COND (.DOFLG '<`SOSE `(P) >) ('<`SOSE -1 `(P) >)>>
422 <EMIT <INSTRUCTION `JRST .START>>)>
424 <COND (<SET NX <GOOD-TUPLE .N>>
425 <OR .ONEFLG <EMIT '<`SUB `P* [<1 (1)>]>>>
426 <ADD:STACK <+ <CHTYPE .NX FIX> 2>>)>)
430 <EMIT <INSTRUCTION `PUSH `P* <ADDRSYM <CHTYPE <DATVAL .NTEM> AC>>>>
431 <EMIT <INSTRUCTION `PUSH `P* <ADDRSYM <CHTYPE <DATVAL .NTEM> AC>>>>)
433 <EMIT <INSTRUCTION `PUSH `P* [.DOFLG]>>
434 <EMIT <INSTRUCTION `PUSH `P* [.DOFLG]>>)>
439 <EMIT <INSTRUCTION `JUMPL
440 <ACSYM <CHTYPE <DATVAL .NTEM> AC>>
442 <EMIT <INSTRUCTION `JUMPE <ACSYM <CHTYPE <DATVAL .NTEM> AC>> .END>>
444 <COND (.GENR <SET ELD <GEN .EL DONT-CARE>>)>
445 <COND (<AND .DOFLG <0? .DOFLG>> <REGSTO T>)
448 <EMIT '<INTGO!-OP!-PACKAGE>>
450 <COND (.GENR <DOEVS .ELD <DATUM ANY-AC ANY-AC>>)
451 (ELSE <GEN .EL <DATUM ANY-AC ANY-AC>>)>>
452 <EMIT <INSTRUCTION `PUSH `TP* <ADDRSYM <CHTYPE <DATTYP .TEM> AC>>>>
453 <EMIT <INSTRUCTION `PUSH `TP* <ADDRSYM <CHTYPE <DATVAL .TEM> AC>>>>
456 <EMIT <INSTRUCTION `SOSE -1 `(P) >>
457 <BRANCH:TAG .START>)>
460 <COND (.DOFLG <EMIT <INSTRUCTION `MOVEI `D* <* .DOFLG 2>>>)
461 (ELSE <EMIT '<`MOVE `D* `(P) >> <EMIT '<`ASH `D* 1>>)>
462 <EMIT '<`AOS `(P) >>)
463 (<EMIT <INSTRUCTION `MOVEI `D* <* .DOFLG 2>>>)>
464 <SET NW <TUPLE:FINAL>>
465 <COND (<==? .W DONT-CARE> .NW) (ELSE <MOVE:ARG .W .NW>)>>
467 <SETG NAMVEC '![ITUPLE ILIST IFORM IVECTOR IUVECTOR ISTRING IBYTES!]>
478 <DEFINE WOFBYTE (SIZ VAL "AUX" (M <MOD 36 .SIZ>) (NUM </ 36 .SIZ>))
479 #DECL ((SIZ VAL NUM M) FIX)
482 <SET TOT <CHTYPE <ORB <LSH .TOT .SIZ> .VAL> FIX>>
483 <AND <L? <SET NUM <- .NUM 1>> 0> <RETURN <LSH .TOT .M>>>>>
484 <ENDPACKAGE>
\ 3\ 3\ 3