Machine-Independent MDL for TOPS-20 and VAX.

[pdp10-muddle.git] / mim / development / mim / mimc / advmess.mud

diff --git a/mim/development/mim/mimc/advmess.mud b/mim/development/mim/mimc/advmess.mud
new file mode 100644 (file)
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>