clu-1976-1989/clu/9005183/rws/clum.mud

"	CLUM MUD	"

;"THIS FILE CONTAINS RANDOM MUDDLE SUPPORT FOR THE CLU COMPILER."
 
<USE "JOBS">
<USE "NOW">
<USE "DATIME">
<USE "DDT">

<SETG :TIME ,TIME>

<DEFINE :CLU_VERSION () .CLU-VERSION>

<SETG :XUNAME ,XUNAME>

<SETG :REALSTRING ,UNPARSE>

<SETG :REALVAL$SUB ,->

<SET :REALVAL$SUB$TYPE :REALVAL>

<DEFINE :SET_DDSKO (CHAN) <SET OUT .CHAN> DONE>

<DEFINE :NO_DDSKO () <UNASSIGN OUT> DONE>

<DEFINE CLU (FS "AUX" IN OUT)
  #DECL( (IN OUT) <SPECIAL CHANNEL> )
  <AND <TYPE? .FS ATOM> <SET FS <PNAME .FS>>>
  <:CLU .FS>>

<OR <BOUND? PARSER-NAME> <SET PARSER-NAME "PARSE">>

<DEFINE :PARSE (FS ES "AUX" PRE PRE1)
  #DECL( (FS ES PRE PRE1) STRING )
  <SET PRE <REST <MEMBER ":" .FS>>>
  <SET PRE <SUBSTRUC .PRE 0 <- <LENGTH .PRE>
			    <LENGTH <MEMBER " " .PRE>>>>>
  <SET PRE1 <SUBSTRUC .PRE>>
  <SET ES <SUBSTRUC .ES>>
  <PUT <MEMBER ";" .PRE> 1 !"/>
  <PUT <MEMBER ";" .ES> 1 !"/>
  <PUT <MEMBER " " .ES> 1 !".>
  <RUN	.PARSER-NAME
	<STRING "\""
		.FS
		"\" "
		.PRE
		".CLUPAR "
		.PRE
		".CLUTAB >"
		.ES
		"
">
	<SNAME>
	<FUNCTION ("TUPLE" X) <PRINT .X> <LISTEN>>
	<>
	"CLU">
  <COND (<==? .OUTCHAN ,OUTCHAN> <GET-TTY>)>
  <:GLOBALS$CREATE <STRING .PRE1 " CLUTAB"> <STRING .PRE1 " CLUPAR">>>
		   
<DEFINE :STAT_FILE ("OPTIONAL" (EL ())) .STAT-FILE>

<SET STAT-FILE "CLU;CLU STAT">

<DEFINE :FUDGE (E)
   <COND (<MONAD? .E>  .E)
	 (<AND <TYPE? .E VECTOR>
	       <1? <LENGTH .E>>
	       <TYPE? <NTH .E 1> LIST>
	       <==? <LENGTH <NTH .E 1>> 2>
	       <TYPE? <NTH <NTH .E 1> 1> FIX>>
	  <VECTOR "" <:FUDGE <NTH .E 1>>>)
	 (T <MAPR <>
		  <FUNCTION (R)
		    <PUT .R 1 <:FUDGE <NTH .R 1>>>>
		  .E>
	    .E)>>

<DEFINE :IN_SYSTEM ("OPTIONAL" E) #FALSE ()>

<DEFINE :TYPE_CHECKING ("OPTIONAL" E) .DO-TC>

<SETG :TYPE_CHECKING$TYPE :BOOL>

<DEFINE :GET_DU_TAB ("OPTIONAL" E) .DU_TAB>  
 
<DEFINE :GET_IDNTAB () .IDNTAB>    
 
<DEFINE :GET_STRTAB () .STRTAB>    
 
<DEFINE :SET_IDNTAB (S) <SET IDNTAB .S>>
 
<DEFINE :SET_STRTAB (S) <SET STRTAB .S>>
 
<DEFINE :TRACING () .TRACING> 
 
<SET TRACING <>>    
 
<SET CLU-VERSION "?">    
 
<SET CLU-DATE "?">  

<DEFINE SAVE-COMPILER (VERSION-NAME
		       "OPTIONAL" (GC-FLAG T) (DIRECTORY "CLU")
		       "AUX" MSG OSNAME Y)
   #DECL ((VALUE VERSION-NAME DIRECTORY MSG OSNAME) STRING)
   #DECL ((Y) <OR CHANNEL FALSE>)
   <SET CLU-VERSION
	<REPEAT (L S N C)
		#DECL ((L) LIST (S) STRING (N) FIX (C) CHARACTER)
		<SET S .VERSION-NAME>
		<SET N <LENGTH .S>>
		<COND (<G? .N 1>
		       <SET C <NTH .S .N>>
		       <COND (<OR <==? .C !"L> <==? .C !"X>>
				<SET S <SUBSTRUC .S 0 <- .N 1>>>)>)>
		<SET L <LPARSE .S>>
		<COND (<OR <N==? <LENGTH .L> 1> <NOT <TYPE? <1 .L> FIX FLOAT>>>
		       <SET VERSION-NAME
			    <ERROR BAD-FORMAT-ERRET-NEW-VERSION-NAME!-ERRORS
				   .VERSION-NAME
				   SAVE-COMPILER>>)
		      (ELSE <RETURN .VERSION-NAME>)>>>
   <SET CLU-DATE <:NICE_DATE>>
   <SET MSG
	<STRING "CLU Compiler Version "
		.VERSION-NAME
		" ("
		.CLU-DATE
		")">>
   <SET OSNAME <SNAME>>
   <SNAME "">
   <SET PROCLIST ()>						      ;"SAVE SOME SPACE"
   <SET IDNTAB NONE>
   <SET STRTAB NONE>
   <COND (<N=? <FSAVE <STRING .DIRECTORY "; CLUSAV " .VERSION-NAME>
		      .GC-FLAG>
	       "RESTORED">
	  <SNAME .OSNAME>
	  <SET MSG
	       <STRING "CLU Compiler Version " .VERSION-NAME " Saved.">>)
	 (ELSE
	  <SET Y <OPEN "READ" "MESSAG" .VERSION-NAME "DSK" "CLU">>
	  <AND .Y <FILECOPY .Y .OUTCHAN> <CLOSE .Y>>
	  <BLOAT 0 0 0 0 0 0 0 100>		   ;" SET FREMIN LOW FOR ACCURATE BLOAT"
	  <BLOAT 52000 0 0 0 0 0 0 100>		     ;" 52000 SHOULD LEAVE 50K FOR PURE"
	  <BLOAT 0 0 0 0 0 0 0 52000>)>		        ;" NOW SET FREMIN NICE AND HIGH"
   .MSG>    
 
<DEFINE :NICE_DATE ("AUX" DAT)
	#DECL ((DAT) <LIST FIX FIX FIX> (VALUE) STRING)
	<SET DAT <DATE>>
	<STRING <UNPARSE <2 .DAT>>
		"/"
		<UNPARSE <3 .DAT>>
		"/"
		<UNPARSE <1 .DAT>>>>

<DEFINE :NICE_TIME ("AUX" DAT)
	#DECL ((DAT) <LIST FIX FIX FIX> (VALUE) STRING)
	<SET DAT <RTIME>>
	<STRING <PR-FIX-2 <1 .DAT>>
		":"
		<PR-FIX-2 <2 .DAT>>>>

<DEFINE PR-FIX-2 (X "AUX" S)
	#DECL ((X) FIX (VALUE S) STRING)
	<SET S <UNPARSE .X>>
	<COND (<L? .X 10> <STRING "0" .S>) (ELSE .S)>>