mim/development/mim/vaxc/mvec.mud

   1 <DEFINE XCOP-PRINT (X "AUX" (OUTCHAN .OUTCHAN))
   2   <PRINC "%<CHANNEL-OPERATION " .OUTCHAN>
   3   <PRIN1 <1 .X> .OUTCHAN>
   4   <PRINC !\  .OUTCHAN>
   5   <PRIN1 <2 .X> .OUTCHAN>
   6   <PRINC !\> .OUTCHAN>>
   7
   8 <DEFINE XGLOC-PRINT (X "AUX" (OUTCHAN .OUTCHAN))
   9         #DECL ((X) XGLOC)
  10         <COND (,BOOT-MODE
  11                <PRIN1 <CHTYPE .X ATOM> .OUTCHAN>
  12                <PRINC !\  .OUTCHAN>)
  13               (T
  14                <PRINC "%<GBIND " .OUTCHAN>
  15                <PRIN1 <CHTYPE .X ATOM> .OUTCHAN>
  16                <PRINC " T> " .OUTCHAN>)>>
  17
  18 <DEFINE XTYPE-C-PRINT  (X "AUX" ATM (OUTCHAN .OUTCHAN))
  19         #DECL ((X) XTYPE-C (ATM) ATOM)
  20         <SET ATM <CHTYPE .X ATOM>>
  21         <PRINC "%<TYPE-C " .OUTCHAN>
  22         <PRIN1 .ATM .OUTCHAN>
  23         <PRINC !\  .OUTCHAN>
  24         <PRIN1 <TYPEPRIM .ATM> .OUTCHAN>
  25         <PRINC ">" .OUTCHAN>>
  26
  27 <DEFINE XTYPE-W-PRINT  (X "AUX" ATM (OUTCHAN .OUTCHAN))
  28         #DECL ((X) XTYPE-W (ATM) ATOM)
  29         <SET ATM <CHTYPE .X ATOM>>
  30         <PRINC "%<TYPE-W " .OUTCHAN>
  31         <PRIN1 .ATM .OUTCHAN>
  32         <PRINC !\  .OUTCHAN>
  33         <PRIN1 <TYPEPRIM .ATM> .OUTCHAN>
  34         <PRINC ">" .OUTCHAN>>
  35
  36 <COND (<GASSIGNED? XCOP-PRINT>
  37        <PRINTTYPE XCHANNEL-OP ,XCOP-PRINT>
  38        <PRINTTYPE XGLOC ,XGLOC-PRINT>
  39        <PRINTTYPE XTYPE-C ,XTYPE-C-PRINT>
  40        <PRINTTYPE XTYPE-W ,XTYPE-W-PRINT>)>
  41
  42 <DEFINE TYPE-CODE (TYP "OPTIONAL" (LENGTH LONG) "AUX" L OFF TST)
  43         #DECL ((TYP) ATOM (L) <OR FALSE VECTOR>)
  44         <PROG ()
  45               <COND (<SET L <MEMQ .TYP ,TYPE-WORDS>>
  46                      <COND (<==? .LENGTH VALUE> <2 .L>)
  47                            (<MA-IMM <2 .L>>)>)
  48                     (<VALID-TYPE? .TYP>
  49                      <SET OFF <ADD-MVEC <CHTYPE .TYP XTYPE-C>>>
  50                      <ADDR-VALUE-M .OFF .LENGTH>)
  51                     (<SET TST <CHECK-MIMOP-TYPE .TYP>> <SET TYP .TST> <AGAIN>)
  52                     (<ERROR "UNDEFINED-TYPE" .TYP>)>>>
  53
  54 <DEFINE TYPE-WORD (TYP "OPTIONAL" (EXTWORD <>) "AUX" L VAL M OFF)
  55         #DECL ((TYP) ATOM (L M) <OR FALSE VECTOR> (VAL) FIX)
  56         <PROG (TST)
  57               <COND (<SET L <MEMQ .TYP ,TYPE-WORDS>>
  58                      <SET VAL <2 .L>>
  59                      <COND (<SET M <MEMQ .TYP ,TYPE-LENGTHS>>
  60                             <SET VAL <CHTYPE <ORB .VAL <LSH <2 .M> 16>> FIX>>)>
  61                      <MA-IMM .VAL>)
  62                     (<VALID-TYPE? .TYP>
  63                      <SET OFF <ADD-MVEC <CHTYPE .TYP XTYPE-W>>>
  64                      <ADDR-VALUE-M .OFF>)
  65                     (<SET TST <CHECK-MIMOP-TYPE .TYP>> <SET TYP .TST> <AGAIN>)
  66                     (<ERROR "UNDEFINED-TYPE" .TYP>)>>>
  67
  68 <GDECL (TYPE-WORDS TYPE-LENGTHS) <VECTOR [REST ATOM FIX]>>
  69
  70 <DEFINE INIT-MVEC-STUFF ()
  71         <SETG MVEC-OFF ,START-MVEC-OFF>
  72         <SETG MVEC-LIST ()>>
  73
  74 <DEFINE PRINT-MVEC-ELEMENTS ("OPTIONAL" (OUTCHAN .OUTCHAN))
  75         #DECL ((OUTCHAN) <SPECIAL CHANNEL>)
  76         <MAPF <> <FCN (X) <PRIN1 .X> <PRINC !\ >> ,MVEC-LIST>>
  77
  78 <MSETG START-MVEC-OFF 16>
  79
  80 <DEFINE ADD-MVEC (ITM "AUX" (OFF ,MVEC-OFF) (LST ,MVEC-LIST) TLST)
  81         #DECL ((ITM) ANY)
  82         <COND (<SET TLST <MEMBER .ITM ,MVEC-LIST>>
  83                <SET OFF <- .OFF <* <LENGTH .TLST> 8>>>)
  84               (ELSE
  85                <COND (<EMPTY? .LST> <SETG MVEC-LIST (.ITM)>)
  86                      (<PUTREST <REST .LST <- <LENGTH .LST> 1>> (.ITM)>)>
  87                <SETG MVEC-OFF <+ .OFF 8>>)>
  88         .OFF>
  89
  90 <DEFINE PRINT-MREF (NUM "AUX" RNUM (OUTCHAN .OUTCHAN))
  91         #DECL ((NUM) FIX)
  92         <SET RNUM <+ </ <- .NUM ,START-MVEC-OFF> 8> 1>>
  93         <PRINC "<MQUOTE " .OUTCHAN>
  94         <PRIN1 <NTH ,MVEC-LIST .RNUM> .OUTCHAN>
  95         <PRINC " " .OUTCHAN>
  96         <PRIN1 <MOD .NUM 8> .OUTCHAN>
  97         <PRINC ">" .OUTCHAN>
  98         <PRINC " " .OUTCHAN>>
  99
 100 <DEFINE ADDR-VALUE-M (OFF "OPTIONAL" (LEN LONG))
 101         #DECL ((OFF) FIX)
 102         <COND (<==? .LEN LONG> <MA-DISP ,AC-M <+ .OFF 4>>)
 103               (ELSE <MA-DISP ,AC-M <+ .OFF 4>>)>>
 104
 105 <DEFINE ADDR-VALUE-MQUOTE (OBJ)
 106         #DECL ((OBJ) ANY)
 107         <ADDR-VALUE-M <ADD-MVEC .OBJ>>>
 108
 109 <DEFINE ADDR-TYPE-MQUOTE (OBJ) #DECL ((OBJ) ANY) <ADDR-TYPE-M <ADD-MVEC .OBJ>>>
 110
 111 <DEFINE ADDR-TYPE-M (OFF)
 112         #DECL ((OFF) FIX)
 113         <MA-DISP ,AC-M .OFF>>
 114
 115 <DEFINE ADDR-COUNT-M (OFF)
 116         #DECL ((OFF) FIX)
 117         <MA-DISP ,AC-M <+ .OFF 2>>>
 118