mim/development/mim/20c/msglue-pm.mud

   1 <DEFINE LVAL-GVAL? (X "AUX" Y)
   2         <OR <TYPE? .X LVAL GVAL>
   3             <AND <TYPE? .X FORM>
   4                  <==? <LENGTH .X> 2>
   5                  <OR <==? <SET Y <1 .X>> LVAL> <==? .Y GVAL>>>>>
   6
   7 <DEFINE LSH-LVAL? (X)
   8         <AND <TYPE? .X FORM>
   9              <==? <LENGTH .X> 3>
  10              <OR <AND <==? <1 .X> LSH>
  11                       <LVAL-GVAL? <2 .X>>
  12                       <TYPE? <3 .X> FIX>
  13                       .X>
  14                  <AND <==? <1 .X> CHTYPE>
  15                       <==? <3 .X> FIX>
  16                       <LSH-LVAL? <2 .X>>>>>>
  17
  18 <DEFMAC PRINTBYTE ('BYT "OPT" (MSK1 *17*) (MSK2 *37*)
  19                    "AUX" (X '.RBYT) (PRE-LSH 0) PL)
  20         <COND (<SET PL <LSH-LVAL? .BYT>>
  21                <SET PRE-LSH <3 <SET BYT <CHTYPE .PL FORM>>>>
  22                <SET BYT <2 .BYT>>)>
  23         <COND (<LVAL-GVAL? .BYT> <SET X .BYT>)>
  24         <FORM PROG <COND (<==? .BYT .X> ())
  25                          (ELSE ((RBYT .BYT)))> #DECL ((RBYT) FIX)
  26               <FORM PUT '.OB 1 <FORM ASCII <FORM + <ASCII !\A>
  27                                               <FORM CHTYPE
  28                                                  <FORM ANDB
  29                                                        <FORM LSH .X
  30                                                              <- .PRE-LSH 5>>
  31                                                        .MSK1> FIX>>>>
  32               '<COND (<EMPTY? <SET OB <REST .OB>>>
  33                       <CHANNEL-OP .OC WRITE-BUFFER <SET OB ,OUTPUT-BUFFER>>)>
  34               <FORM PUT '.OB 1 <FORM ASCII <FORM + <ASCII !\A>
  35                                               <FORM CHTYPE
  36                                                 <FORM ANDB
  37                                                       <COND (<==? .PRE-LSH 0> .X)
  38                                                             (ELSE
  39                                                              <FORM LSH .X
  40                                                                    .PRE-LSH>)>
  41                                                       .MSK2> FIX>>>>
  42               '<COND (<EMPTY? <SET OB <REST .OB>>>
  43                       <CHANNEL-OP .OC WRITE-BUFFER <SET OB ,OUTPUT-BUFFER>>)>>>
  44