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

diff --git a/mim/development/mim/mimc/advmess.mud b/mim/development/mim/mimc/advmess.mud
new file mode 100644
index 0000000..72f7e32
--- /dev/null
+++ b/mim/development/mim/mimc/advmess.mud
@@ -0,0 +1,85 @@
+
+<PACKAGE "ADVMESS">
+
+<ENTRY VMESS ANA-MESS ADDVMESS COMPILE-ERROR COMPILE-LOSSAGE COMPILE-WARNING
+       COMPILE-NOTE COMPILE-ACTIVATION>
+
+<USE "NPRINT" "COMPDEC">
+
+<DEFINE VMESS ("TUPLE" MSG) 
+	#DECL ((MSG) TUPLE)
+	<PRINC "===== ">
+	<MAPF <>
+	      <FUNCTION (O) 
+		      <COND (<TYPE? .O STRING> <PRINC .O>) (ELSE <PRIN1 .O>)>>
+	      .MSG>
+	<CRLF>>
+
+<DEFINE ANA-MESS (L) 
+	#DECL ((L) <LIST ANY [REST NODE LIST]>)
+	<REPEAT ((LL <REST .L>))
+		#DECL ((LL) <LIST [REST NODE LIST]>)
+		<COND (<EMPTY? .LL> <RETURN>)>
+		<PRINC "===== ">
+		<MAPF <>
+		      <FUNCTION (O) 
+			      <COND (<TYPE? .O NODE> <NODE-COMPLAIN .O>)
+				    (<TYPE? .O STRING> <PRINC .O>)
+				    (ELSE <PRIN1 .O>)>>
+		      <2 .LL>>
+		<CRLF>
+		<NODE-COMPLAIN <1 .LL>>
+		<SET LL <REST .LL 2>>>>
+
+<DEFINE ADDVMESS (N L "AUX" LL (V .VERBOSE))
+	#DECL ((N) NODE (L) LIST (V VERBOSE) <LIST [REST NODE LIST]>
+	       (LL) <PRIMTYPE LIST>)
+	<COND (<SET LL <MEMQ .N .V>>
+	       <PUTREST <REST <SET LL <2 .LL>> <- <LENGTH .LL> -1>> .L>)
+	      (ELSE
+	       <SET VERBOSE <REST <PUTREST .V (.N .L)> 2>>)>>
+
+
+<DEFINE COMPILE-ERROR ("TUPLE" X)
+	<PRINC "*** ERROR ">
+	<MAPF <>
+	      <FUNCTION (IT)
+		<COND (<TYPE? .IT STRING> <PRINC .IT>)
+		      (<TYPE? .IT NODE> <NODE-COMPLAIN .IT>)
+		      (ELSE <PRIN1 .IT>)>
+		<PRINC " ">> .X>
+	<COND (<AND <GASSIGNED? DEBUGSW> ,DEBUGSW> <ERROR>)>
+	<RETURN <> .COMPILE-ACTIVATION>>
+
+<DEFINE COMPILE-LOSSAGE ("TUPLE" X)
+	<PRINC "*** LOSSAGE ">
+	<MAPF <>
+	      <FUNCTION (IT)
+		<COND (<TYPE? .IT STRING> <PRINC .IT>)
+		      (<TYPE? .IT NODE> <NODE-COMPLAIN .IT>)
+		      (ELSE <PRIN1 .IT>)>
+		<PRINC " ">> .X>
+	<ERROR LOSSAGE!-ERRORS>>
+
+<DEFINE COMPILE-WARNING ("TUPLE" X)
+	<PRINC "*** WARNING ">
+	<MAPF <>
+	      <FUNCTION (IT)
+		<COND (<TYPE? .IT STRING> <PRINC .IT>)
+		      (<TYPE? .IT NODE> <NODE-COMPLAIN .IT>)
+		      (ELSE <PRIN1 .IT>)>
+		<PRINC " ">> .X>
+	<CRLF>>
+
+
+<DEFINE COMPILE-NOTE ("TUPLE" X)
+	<PRINC "*** NOTE ">
+	<MAPF <>
+	      <FUNCTION (IT)
+		<COND (<TYPE? .IT STRING> <PRINC .IT>)
+		      (<TYPE? .IT NODE> <NODE-COMPLAIN .IT>)
+		      (ELSE <PRIN1 .IT>)>
+		<PRINC " ">> .X>
+	<CRLF>>
+
+<ENDPACKAGE>