X-Git-Url: https://jxself.org/git/?p=pdp10-muddle.git;a=blobdiff_plain;f=mim%2Fdevelopment%2Fmim%2Fvaxc%2Fmvec.mud;fp=mim%2Fdevelopment%2Fmim%2Fvaxc%2Fmvec.mud;h=31a37249195a8aeee981c57e42003f48e5ea0186;hp=0000000000000000000000000000000000000000;hb=d73ace3f3292e320b461b8fcd2e9f5dc5d9684d7;hpb=d530283ea60fb0ddcc28e9c5bd072456afe06e07

diff --git a/mim/development/mim/vaxc/mvec.mud b/mim/development/mim/vaxc/mvec.mud
new file mode 100644
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