1 <COND (<NOT <GASSIGNED? M$$R-BHWD>> <SETG M$$R-BHWD 18>)>
3 <COND (<GASSIGNED? PUTBITS>
4 <SETG OPUTBITS ,PUTBITS>
5 <SETG OGETBITS ,GETBITS>
8 <DEFMAC BITS ('WID "OPTIONAL" ('SHFT 0))
9 <FORM CHTYPE <FORM ORB .SHFT <FORM LSH .WID ,M$$R-BHWD>> BITS>>
11 <DEFMAC GETBITS ('FROM 'BTS "AUX" RB FV)
12 <COND (<SET RB <HACK-BITS .BTS>>
13 <COND (<AND <SET FV <CONST? .FROM>>
16 <FGETBITS .FV <1 .RB> <2 .RB>>)
20 <FORM ANDB .FROM <XORB <LSH -1 <1 .RB>> -1>>)
21 (<FORM FGETBITS .FROM <1 .RB> <2 .RB>>)>)
23 <FORM BIND ((MSK <FORM LSH -1 <FORM - ',M$$R-BHWD>>)
24 (RB .BTS) (SHFT <FORM ANDB '.RB '.MSK>)
25 (WID <FORM ANDB <FORM LSH '.RB <FORM - ',M$$R-BHWD>>
27 <FORM FGETBITS .FROM '.WID '.SHFT>>)>>
29 <DEFMAC PUTBITS ('TO 'BTS "OPTIONAL" ('FROM 0) "AUX" RB FV TV)
30 <COND (<SET RB <HACK-BITS .BTS>>
31 <COND (<AND <SET FV <CONST? .FROM>>
35 <FPUTBITS .TV <1 .RB> <2 .RB> .FV>)
41 <FORM ANDB .TO <LSH -1 <1 .RB>>>)
42 (<FORM FPUTBITS .TO <1 .RB> <2 .RB> .FROM>)>)
44 <FORM BIND ((MSK <FORM LSH -1 <FORM - ',M$$R-BHWD>>)
45 (RB .BTS) (SHFT <FORM ANDB '.RB '.MSK>)
46 (WID <FORM ANDB <FORM LSH '.RB <FORM - ',M$$R-BHWD>>
48 <FORM FPUTBITS .TO '.WID '.SHFT .FROM>>)>>
51 <COND (<MEMQ <PRIMTYPE .FROB> '[WORD FIX]>
53 (<AND <TYPE? .FROB GVAL>
54 <MANIFEST? <CHTYPE .FROB ATOM>>>
56 (<AND <TYPE? .FROB FORM>
57 <==? <LENGTH .FROB> 2>
59 <TYPE? <2 .FROB> GVAL>
60 <MANIFEST? <2 .FROB>>>
63 <DEFINE HACK-BITS (BTS "AUX" WID SHIFT MSK HWD NV)
64 <COND (<SET NV <CONST? .BTS>>
65 <COND (<==? <PRIMTYPE 1> FIX>
68 <SET MSK <LSH -1 <- .HWD>>>
69 <SET SHIFT <CHTYPE <ORB .NV .MSK> FIX>>
70 <SET WID <CHTYPE <ORB <LSH .NV <- .HWD>> .MSK> FIX>>
72 (<AND <TYPE? .BTS FORM>
73 <NOT <LENGTH? .BTS 1>>
75 (<2 .BTS> <COND (<LENGTH? .BTS 2> 0)
78 <DEFINE FGETBITS (FROM WID SHIFT "AUX" (MSK <XORB <LSH -1 .WID> -1>))
79 <CHTYPE <ANDB <LSH .FROM <- .SHIFT>> .MSK> FIX>>
81 <DEFINE FPUTBITS (TO WID SHIFT FROM "AUX" (MSK <LSH -1 .WID>))
82 <CHTYPE <ORB <LSH <ANDB .FROM <XORB .MSK -1>> .SHIFT>
83 <ANDB .TO <ROT .MSK .SHIFT>>>