mim/development/mim/vaxc/cbits.mud

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