4 <ENTRY BIT-ANA GETBITS-ANA PUTBITS-ANA BITLOG>
6 <USE "SYMANA" "CHKDCL" "COMPDEC">
8 "MUDDLE BITS,GETBITS,PUTBITS,ANDB,XORB,EQVB AND ORB COMPILER ROUTINES."
10 <DEFINE BIT-ANA (NOD RTYP "AUX" (K <KIDS .NOD>) (POSN 0) POS WIDTH)
11 #DECL ((WIDTH POS NOD) NODE (K) <LIST [REST NODE]>)
12 <COND (<SEGFLUSH .NOD .RTYP>)
14 <ARGCHK <LENGTH .K> '(1 2) BITS>
15 <EANA <SET WIDTH <1 .K>> FIX BITS>
16 <COND (<NOT <EMPTY? <REST .K>>>
17 <EANA <SET POS <2 .K>> FIX BITS>
18 <SET POSN <NODE-NAME .POS>> ;"May be position field.")>
19 <COND (<AND <==? <NODE-TYPE .WIDTH> ,QUOTE-CODE>
20 <OR <NOT <ASSIGNED? POS>> ;"Only one arg."
21 <==? <NODE-TYPE .POS> ,QUOTE-CODE>>>
22 <PUT .NOD ,NODE-TYPE ,QUOTE-CODE>
23 <PUT .NOD ,NODE-NAME <BITS <NODE-NAME .WIDTH> .POSN>>
25 (ELSE <PUT .NOD ,NODE-TYPE ,BITS-CODE>)>)>
26 <TYPE-OK? BITS .RTYP>>
28 <PUT ,BITS ANALYSIS ,BIT-ANA>
30 <DEFINE GETBITS-ANA (N R) #DECL ((N) NODE) <PGBITS .N .R 2 ,GETBITS-CODE>>
32 <PUT ,GETBITS ANALYSIS ,GETBITS-ANA>
34 <DEFINE PUTBITS-ANA (N R) <PGBITS .N .R '(2 3) ,PUTBITS-CODE>>
36 <PUT ,PUTBITS ANALYSIS ,PUTBITS-ANA>
38 <DEFINE PGBITS (NOD RTYP NARG COD "AUX" (K <KIDS .NOD>) (NAM <NODE-NAME .NOD>))
39 #DECL ((NOD) NODE (COD) FIX (K) <LIST [REST NODE]>)
40 <COND (<SEGFLUSH .NOD .RTYP>)
42 <ARGCHK <LENGTH .K> .NARG .NAM>
43 <PUT .NOD ,NODE-TYPE .COD>
45 <COND (<==? .COD ,GETBITS-CODE>
48 (ELSE '<PRIMTYPE WORD>)>
50 <EANA <2 .K> BITS .NAM>
51 <AND <==? <LENGTH .K> 3>
52 <EANA <3 .K> '<PRIMTYPE WORD> .NAM>>)>
53 <TYPE-OK? <COND (<==? .COD ,GETBITS-CODE> WORD)
54 (<ISTYPE? <RESULT-TYPE <1 .K>>>)
55 (ELSE '<PRIMTYPE WORD>)>
58 <DEFINE BITLOG (NOD RTYP "AUX" (K <KIDS .NOD>) (LN <LENGTH .K>))
59 #DECL ((NOD) NODE (K) <LIST [REST NODE]> (LN) FIX)
60 <COND (<SEGFLUSH .NOD .RTYP>)
62 <PUT .NOD ,NODE-TYPE ,QUOTE-CODE>
64 <PUT .NOD ,NODE-NAME <APPLY <NODE-SUBR .NOD>>>)
65 (<1? .LN> <PUT .NOD ,NODE-TYPE ,ID-CODE>)
67 <PUT .NOD ,NODE-TYPE ,BITL-CODE>
71 <EANA .K1 '<PRIMTYPE WORD> <NODE-NAME .NOD>>>
73 <TYPE-OK? WORD .RTYP>>
75 <PUT ,ANDB ANALYSIS ,BITLOG>
77 <PUT ,ORB ANALYSIS ,BITLOG>
79 <PUT ,XORB ANALYSIS ,BITLOG>
81 <PUT ,EQVB ANALYSIS ,BITLOG>