Machine-Independent MDL for TOPS-20 and VAX.

[pdp10-muddle.git] / mim / development / mim / vaxc / mvec.mud

diff --git a/mim/development/mim/vaxc/mvec.mud b/mim/development/mim/vaxc/mvec.mud
new file mode 100644 (file)
index 0000000..31a3724
--- /dev/null
+++ b/mim/development/mim/vaxc/mvec.mud
@@ -0,0 +1,118 @@
+<DEFINE XCOP-PRINT (X "AUX" (OUTCHAN .OUTCHAN))
+  <PRINC "%<CHANNEL-OPERATION " .OUTCHAN>
+  <PRIN1 <1 .X> .OUTCHAN>
+  <PRINC !\  .OUTCHAN>
+  <PRIN1 <2 .X> .OUTCHAN>
+  <PRINC !\> .OUTCHAN>>
+
+<DEFINE XGLOC-PRINT (X "AUX" (OUTCHAN .OUTCHAN))
+       #DECL ((X) XGLOC)
+       <COND (,BOOT-MODE
+              <PRIN1 <CHTYPE .X ATOM> .OUTCHAN>
+              <PRINC !\  .OUTCHAN>)
+             (T
+              <PRINC "%<GBIND " .OUTCHAN>
+              <PRIN1 <CHTYPE .X ATOM> .OUTCHAN>
+              <PRINC " T> " .OUTCHAN>)>>
+
+<DEFINE XTYPE-C-PRINT  (X "AUX" ATM (OUTCHAN .OUTCHAN))
+       #DECL ((X) XTYPE-C (ATM) ATOM)
+       <SET ATM <CHTYPE .X ATOM>>
+       <PRINC "%<TYPE-C " .OUTCHAN>
+       <PRIN1 .ATM .OUTCHAN>
+       <PRINC !\  .OUTCHAN>
+       <PRIN1 <TYPEPRIM .ATM> .OUTCHAN>
+       <PRINC ">" .OUTCHAN>>
+
+<DEFINE XTYPE-W-PRINT  (X "AUX" ATM (OUTCHAN .OUTCHAN))
+       #DECL ((X) XTYPE-W (ATM) ATOM)
+       <SET ATM <CHTYPE .X ATOM>>
+       <PRINC "%<TYPE-W " .OUTCHAN>
+       <PRIN1 .ATM .OUTCHAN>
+       <PRINC !\  .OUTCHAN>
+       <PRIN1 <TYPEPRIM .ATM> .OUTCHAN>
+       <PRINC ">" .OUTCHAN>>
+
+<COND (<GASSIGNED? XCOP-PRINT>
+       <PRINTTYPE XCHANNEL-OP ,XCOP-PRINT>
+       <PRINTTYPE XGLOC ,XGLOC-PRINT>
+       <PRINTTYPE XTYPE-C ,XTYPE-C-PRINT>
+       <PRINTTYPE XTYPE-W ,XTYPE-W-PRINT>)>
+
+<DEFINE TYPE-CODE (TYP "OPTIONAL" (LENGTH LONG) "AUX" L OFF TST) 
+       #DECL ((TYP) ATOM (L) <OR FALSE VECTOR>)
+       <PROG ()
+             <COND (<SET L <MEMQ .TYP ,TYPE-WORDS>>
+                    <COND (<==? .LENGTH VALUE> <2 .L>)
+                          (<MA-IMM <2 .L>>)>)
+                   (<VALID-TYPE? .TYP>
+                    <SET OFF <ADD-MVEC <CHTYPE .TYP XTYPE-C>>>
+                    <ADDR-VALUE-M .OFF .LENGTH>)
+                   (<SET TST <CHECK-MIMOP-TYPE .TYP>> <SET TYP .TST> <AGAIN>)
+                   (<ERROR "UNDEFINED-TYPE" .TYP>)>>>
+
+<DEFINE TYPE-WORD (TYP "OPTIONAL" (EXTWORD <>) "AUX" L VAL M OFF) 
+       #DECL ((TYP) ATOM (L M) <OR FALSE VECTOR> (VAL) FIX)
+       <PROG (TST)
+             <COND (<SET L <MEMQ .TYP ,TYPE-WORDS>>
+                    <SET VAL <2 .L>>
+                    <COND (<SET M <MEMQ .TYP ,TYPE-LENGTHS>>
+                           <SET VAL <CHTYPE <ORB .VAL <LSH <2 .M> 16>> FIX>>)>
+                    <MA-IMM .VAL>)
+                   (<VALID-TYPE? .TYP>
+                    <SET OFF <ADD-MVEC <CHTYPE .TYP XTYPE-W>>>
+                    <ADDR-VALUE-M .OFF>)
+                   (<SET TST <CHECK-MIMOP-TYPE .TYP>> <SET TYP .TST> <AGAIN>)
+                   (<ERROR "UNDEFINED-TYPE" .TYP>)>>>
+
+<GDECL (TYPE-WORDS TYPE-LENGTHS) <VECTOR [REST ATOM FIX]>>
+
+<DEFINE INIT-MVEC-STUFF ()
+       <SETG MVEC-OFF ,START-MVEC-OFF>
+       <SETG MVEC-LIST ()>>
+
+<DEFINE PRINT-MVEC-ELEMENTS ("OPTIONAL" (OUTCHAN .OUTCHAN))
+       #DECL ((OUTCHAN) <SPECIAL CHANNEL>)
+       <MAPF <> <FCN (X) <PRIN1 .X> <PRINC !\ >> ,MVEC-LIST>>
+
+<MSETG START-MVEC-OFF 16>
+
+<DEFINE ADD-MVEC (ITM "AUX" (OFF ,MVEC-OFF) (LST ,MVEC-LIST) TLST) 
+       #DECL ((ITM) ANY)
+       <COND (<SET TLST <MEMBER .ITM ,MVEC-LIST>>
+              <SET OFF <- .OFF <* <LENGTH .TLST> 8>>>)
+             (ELSE
+              <COND (<EMPTY? .LST> <SETG MVEC-LIST (.ITM)>)
+                    (<PUTREST <REST .LST <- <LENGTH .LST> 1>> (.ITM)>)>
+              <SETG MVEC-OFF <+ .OFF 8>>)>
+       .OFF>
+
+<DEFINE PRINT-MREF (NUM "AUX" RNUM (OUTCHAN .OUTCHAN)) 
+       #DECL ((NUM) FIX)
+       <SET RNUM <+ </ <- .NUM ,START-MVEC-OFF> 8> 1>>
+       <PRINC "<MQUOTE " .OUTCHAN>
+       <PRIN1 <NTH ,MVEC-LIST .RNUM> .OUTCHAN>
+       <PRINC " " .OUTCHAN>
+       <PRIN1 <MOD .NUM 8> .OUTCHAN>
+       <PRINC ">" .OUTCHAN>
+       <PRINC " " .OUTCHAN>>
+
+<DEFINE ADDR-VALUE-M (OFF "OPTIONAL" (LEN LONG)) 
+       #DECL ((OFF) FIX)
+       <COND (<==? .LEN LONG> <MA-DISP ,AC-M <+ .OFF 4>>)
+             (ELSE <MA-DISP ,AC-M <+ .OFF 4>>)>>
+
+<DEFINE ADDR-VALUE-MQUOTE (OBJ) 
+       #DECL ((OBJ) ANY)
+       <ADDR-VALUE-M <ADD-MVEC .OBJ>>>
+
+<DEFINE ADDR-TYPE-MQUOTE (OBJ) #DECL ((OBJ) ANY) <ADDR-TYPE-M <ADD-MVEC .OBJ>>>
+
+<DEFINE ADDR-TYPE-M (OFF)
+       #DECL ((OFF) FIX)
+       <MA-DISP ,AC-M .OFF>>
+
+<DEFINE ADDR-COUNT-M (OFF)
+       #DECL ((OFF) FIX)
+       <MA-DISP ,AC-M <+ .OFF 2>>>
+ 
\ No newline at end of file