X-Git-Url: https://jxself.org/git/?p=pdp10-muddle.git;a=blobdiff_plain;f=mim%2Fdevelopment%2Fmim%2Fvax%2Fmimlib%2Fformat.mud;fp=mim%2Fdevelopment%2Fmim%2Fvax%2Fmimlib%2Fformat.mud;h=9f8153059ddc241c86f5a851feaecc809172bb46;hp=0000000000000000000000000000000000000000;hb=d73ace3f3292e320b461b8fcd2e9f5dc5d9684d7;hpb=d530283ea60fb0ddcc28e9c5bd072456afe06e07

diff --git a/mim/development/mim/vax/mimlib/format.mud b/mim/development/mim/vax/mimlib/format.mud
new file mode 100644
index 0000000..9f81530
--- /dev/null
+++ b/mim/development/mim/vax/mimlib/format.mud
@@ -0,0 +1,62 @@
+<PACKAGE "FORMAT">
+
+<USE "PP">
+
+<ENTRY FORMAT>
+
+<DEFINE FORMAT (IN-NM "OPT" (OUT-NM .IN-NM)
+		"AUX" DENSE (QUICKPRINT T) (LOOKAHEAD T)
+		"AUX" INCHAN OUTCHAN)
+   #DECL ((IN-NM OUT-NM) STRING (INCHAN) <OR FALSE CHANNEL>
+	  (OUTCHAN) <SPECIAL <OR FALSE CHANNEL>>
+	  (DENSE QUICKPRINT LOOKAHEAD) <SPECIAL <OR ATOM FALSE>>)
+   <COND
+    (<SET INCHAN <OPEN "READ" .IN-NM>>
+     <UNWIND
+      <COND
+       (<SET OUTCHAN <OPEN "PRINT" "TEMP.FORMAT">>
+	<UNWIND <REPEAT (OLDKEY NEWKEY ITM (FIRST-ITEM? T))
+		   #DECL ((OLDKEY NEWKEY) ATOM (ITM) ANY)
+		   <SET ITM <READ .INCHAN '<RETURN>>>
+		   <COND (<AND <TYPE? .ITM FORM>
+			       <NOT <EMPTY? .ITM>>
+			       <TYPE? <1 .ITM> ATOM>>
+			  <SET NEWKEY <1 .ITM>>)
+			 (ELSE <SET NEWKEY <TYPE .ITM>>)>
+		   <SET DENSE <GETPROP .NEWKEY DENSE>>
+		   <COND (.FIRST-ITEM? <SET FIRST-ITEM? %<>>)
+			 (ELSE
+			  <REPEAT ((CRLFS
+				    <OR <GETPROP .OLDKEY .NEWKEY>
+					<GETPROP ANY .NEWKEY>
+					<GETPROP .OLDKEY ANY 2>>))
+			     #DECL ((CRLFS) FIX)
+			     <COND (<==? .CRLFS 0> <RETURN>)
+				   (ELSE
+				    <CRLF .OUTCHAN>
+				    <SET CRLFS <- .CRLFS 1>>)>>)>
+		   <EPRIN1 .ITM>
+		   <SET OLDKEY .NEWKEY>>
+		<FLUSH .OUTCHAN>>
+	<CLOSE .INCHAN>
+	<AND <CLOSE .OUTCHAN>
+	     <RENAME "TEMP.FORMAT" .OUT-NM>>
+	"DONE")
+       (ELSE <CLOSE .INCHAN> #FALSE (Cannot-open-output-file))>
+      <CLOSE .INCHAN>>)
+    (ELSE #FALSE (Cannot-open-input-file))>>
+
+<ENDPACKAGE>
+
+<PUTPROP SETG MANIFEST 1>
+<PUTPROP SETG SETG 1>
+<PUTPROP NEWTYPE SETG 1>
+<PUTPROP MSETG SETG 1>
+<PUTPROP MSETG MSETG 1>
+<PUTPROP SETG MSETG 1>
+<PUTPROP NEWTYPE MSETG 1>
+<PUTPROP PUTPROP PUTPROP 1>
+<PUTPROP GDECL DENSE T>
+<PUTPROP MANIFEST DENSE T>
+<PUTPROP ENTRY DENSE T>
+<PUTPROP RENTRY DENSE T>