Machine-Independent MDL for TOPS-20 and VAX.

[pdp10-muddle.git] / mim / development / mim / vax / mimlib / format.mud

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