4 <ENTRY FGETBITS-ANA FPUTBITS-ANA BITLOG>
6 <USE "SYMANA" "CHKDCL" "COMPDEC">
8 "MUDDLE BITS,GETBITS,PUTBITS,ANDB,XORB,EQVB AND ORB COMPILER ROUTINES."
10 <DEFINE FGETBITS-ANA (N R) #DECL ((N) NODE) <PGBITS .N .R 3 ,FGETBITS-CODE>>
12 <COND (<AND <GASSIGNED? FGETBITS>
13 <GASSIGNED? FGETBITS-ANA>>
14 <PUTPROP ,FGETBITS ANALYSIS ,FGETBITS-ANA>)>
16 <DEFINE FPUTBITS-ANA (N R) <PGBITS .N .R 4 ,FPUTBITS-CODE>>
18 <COND (<AND <GASSIGNED? FPUTBITS>
19 <GASSIGNED? FPUTBITS-ANA>>
20 <PUTPROP ,FPUTBITS ANALYSIS ,FPUTBITS-ANA>)>
22 <DEFINE PGBITS (NOD RTYP NARG COD "AUX" (K <KIDS .NOD>)
23 (NAM <NODE-NAME .NOD>))
24 #DECL ((NOD) NODE (COD) FIX (K) <LIST [REST NODE]>)
25 <COND (<SEGFLUSH .NOD .RTYP>)
27 <ARGCHK <LENGTH .K> .NARG .NAM .NOD>
28 <PUT .NOD ,NODE-TYPE .COD>
29 <EANA <1 .K> '<PRIMTYPE FIX> .NAM>
30 <EANA <2 .K> FIX .NAM>
31 <EANA <3 .K> FIX .NAM>
32 <COND (<==? <LENGTH .K> 4>
33 <EANA <4 .K> '<PRIMTYPE FIX> .NAM>)>)>
36 <DEFINE BITLOG (NOD RTYP "AUX" (K <KIDS .NOD>) (LN <LENGTH .K>) (NL (0))
37 (IC <CHTYPE <APPLY <NODE-SUBR .NOD>> FIX>)
39 #DECL ((NOD) NODE (K) <LIST [REST NODE]> (LN) FIX
41 <COND (<SEGFLUSH .NOD .RTYP>)
43 <PUT .NOD ,NODE-TYPE ,QUOTE-CODE>
45 <PUT .NOD ,NODE-NAME <APPLY <NODE-SUBR .NOD>>>)
47 <PUT .NOD ,NODE-TYPE ,BITL-CODE>
51 <EANA .K1 '<PRIMTYPE WORD> <NODE-NAME .NOD>>
52 <COND (<==? <NODE-TYPE .K1> ,QUOTE-CODE>
54 <SET IC <CHTYPE <APPLY <NODE-SUBR .NOD>
58 (<AND <==? <NODE-TYPE .K1> ,BITL-CODE>
64 <SET NP <REST .NP <- <LENGTH .NP> 1>>>)
66 <PUTREST .NP <SET NP (.K1)>>)>>
68 <COND (<EMPTY? <SET NL <REST .NL>>>
69 <PUT .NOD ,NODE-TYPE ,QUOTE-CODE>
70 <PUT .NOD ,NODE-NAME .IC>
74 <PUT .CN ,NODE-NAME <CHTYPE .IC WORD>>
76 <PUT .NOD ,KIDS .NL>)>)>
79 <DEFINE COMBINE-LOGICAL-OPS (P:NODE N:NODE NP:LIST IC)
82 <COND (<==? <NODE-TYPE .NN> ,QUOTE-CODE>
83 <SET IC <CHTYPE <APPLY <NODE-SUBR .P>
88 (<AND <==? <NODE-TYPE .NN> ,BITL-CODE>
89 <==? <NODE-SUBR .NN> <NODE-SUBR .P>>>
90 <SET IC <COMBINE-LOGICAL-OPS .P .NN .NP .IC>>
91 <SET NP <REST .NP <- <LENGTH .NP> 1>>>)
94 <PUTREST .NP <SET NP (.NN)>>)>>
98 <COND (<GASSIGNED? BITLOG>
99 <PUTPROP ,ANDB ANALYSIS ,BITLOG>
100 <PUTPROP ,ORB ANALYSIS ,BITLOG>
101 <PUTPROP ,XORB ANALYSIS ,BITLOG>
102 <PUTPROP ,EQVB ANALYSIS ,BITLOG>)>