mim/development/mim/vax/mimlib/cbits.mud

   1
   2
   3 <COND (<NOT <GASSIGNED? M$$R-BHWD>> <SETG M$$R-BHWD 18>)>
   4
   5 <COND (<GASSIGNED? PUTBITS>
   6        <SETG OPUTBITS ,PUTBITS>
   7        <SETG OGETBITS ,GETBITS>
   8        <SETG OBITS ,BITS>)>
   9
  10 <DEFMAC BITS ('WID "OPTIONAL" ('SHFT 0))
  11   <FORM CHTYPE <FORM ORB .SHFT <FORM LSH .WID ,M$$R-BHWD>> BITS>>
  12
  13 <DEFMAC GETBITS ('FROM 'BTS "AUX" RB FV)
  14   <COND (<SET RB <HACK-BITS .BTS>>
  15          <COND (<AND <SET FV <CONST? .FROM>>
  16                      <TYPE? <1 .RB> FIX>
  17                      <TYPE? <2 .RB> FIX>>
  18                 <FGETBITS .FV <1 .RB> <2 .RB>>)
  19                (<==? <1 .RB> 0> 0)
  20                (<AND <==? <2 .RB> 0>
  21                      <TYPE? <1 .RB> FIX>>
  22                 <FORM ANDB .FROM <XORB <LSH -1 <1 .RB>> -1>>)
  23                (<FORM FGETBITS .FROM <1 .RB> <2 .RB>>)>)
  24         (T
  25          <FORM BIND ((MSK <FORM LSH -1 <FORM - ',M$$R-BHWD>>)
  26                      (RB .BTS) (SHFT <FORM ANDB '.RB '.MSK>)
  27                      (WID <FORM ANDB <FORM LSH '.RB <FORM - ',M$$R-BHWD>>
  28                                 '.MSK>))
  29            <FORM FGETBITS .FROM '.WID '.SHFT>>)>>
  30
  31 <DEFMAC PUTBITS ('TO 'BTS "OPTIONAL" ('FROM 0) "AUX" RB FV TV)
  32   <COND (<SET RB <HACK-BITS .BTS>>
  33          <COND (<AND <SET FV <CONST? .FROM>>
  34                      <SET TV <CONST? .TO>>
  35                      <TYPE? <1 .RB> FIX>
  36                      <TYPE? <2 .RB> FIX>>
  37                 <FPUTBITS .TV <1 .RB> <2 .RB> .FV>)
  38                (<==? <1 .RB> 0>
  39                 .TO)
  40                (<AND <==? <2 .RB> 0>
  41                      <TYPE? <1 .RB> FIX>
  42                      <==? .FV 0>>
  43                 <FORM ANDB .TO <LSH -1 <1 .RB>>>)
  44                (<FORM FPUTBITS .TO <1 .RB> <2 .RB> .FROM>)>)
  45         (T
  46          <FORM BIND ((MSK <FORM LSH -1 <FORM - ',M$$R-BHWD>>)
  47                      (RB .BTS) (SHFT <FORM ANDB '.RB '.MSK>)
  48                      (WID <FORM ANDB <FORM LSH '.RB <FORM - ',M$$R-BHWD>>
  49                                 '.MSK>))
  50            <FORM FPUTBITS .TO '.WID '.SHFT .FROM>>)>>
  51
  52 <DEFINE CONST? (FROB)
  53   <COND (<MEMQ <PRIMTYPE .FROB> '[WORD FIX]>
  54          .FROB)
  55         (<AND <TYPE? .FROB GVAL>
  56               <MANIFEST? <CHTYPE .FROB ATOM>>>
  57          ,<CHTYPE .FROB ATOM>)
  58         (<AND <TYPE? .FROB FORM>
  59               <==? <LENGTH .FROB> 2>
  60               <==? <1 .FROB> GVAL>
  61               <TYPE? <2 .FROB> ATOM>
  62               <MANIFEST? <2 .FROB>>>
  63          ,<2 .FROB>)>>
  64
  65 <DEFINE HACK-BITS (BTS "AUX" WID SHIFT MSK HWD NV)
  66   <COND (<SET NV <CONST? .BTS>>
  67          <COND (<==? <PRIMTYPE 1> FIX>
  68                 <SET HWD ,M$$R-BHWD>)
  69                (<SET HWD 18>)>
  70          <SET MSK <LSH -1 <- .HWD>>>
  71          <SET SHIFT <CHTYPE <ANDB .NV .MSK> FIX>>
  72          <SET WID <CHTYPE <ANDB <LSH .NV <- .HWD>> .MSK> FIX>>
  73          (.WID .SHIFT))
  74         (<AND <TYPE? .BTS FORM>
  75               <NOT <LENGTH? .BTS 1>>
  76               <==? <1 .BTS> BITS>>
  77          (<2 .BTS> <COND (<LENGTH? .BTS 2> 0)
  78                          (<3 .BTS>)>))>>
  79
  80 <DEFINE FGETBITS (FROM WID SHIFT "AUX" (MSK <XORB <LSH -1 .WID> -1>))
  81   <CHTYPE <ANDB <LSH .FROM <- .SHIFT>> .MSK> FIX>>
  82
  83 <DEFINE FPUTBITS (TO WID SHIFT FROM "AUX" (MSK <LSH -1 .WID>))
  84   <CHTYPE <ORB <LSH <ANDB .FROM <XORB .MSK -1>> .SHIFT>
  85                <ANDB .TO <ROT .MSK .SHIFT>>>
  86           FIX>>