mim/development/mim/vax/mimlib/format.mud

   1 <PACKAGE "FORMAT">
   2
   3 <USE "PP">
   4
   5 <ENTRY FORMAT>
   6
   7 <DEFINE FORMAT (IN-NM "OPT" (OUT-NM .IN-NM)
   8                 "AUX" DENSE (QUICKPRINT T) (LOOKAHEAD T)
   9                 "AUX" INCHAN OUTCHAN)
  10    #DECL ((IN-NM OUT-NM) STRING (INCHAN) <OR FALSE CHANNEL>
  11           (OUTCHAN) <SPECIAL <OR FALSE CHANNEL>>
  12           (DENSE QUICKPRINT LOOKAHEAD) <SPECIAL <OR ATOM FALSE>>)
  13    <COND
  14     (<SET INCHAN <OPEN "READ" .IN-NM>>
  15      <UNWIND
  16       <COND
  17        (<SET OUTCHAN <OPEN "PRINT" "TEMP.FORMAT">>
  18         <UNWIND <REPEAT (OLDKEY NEWKEY ITM (FIRST-ITEM? T))
  19                    #DECL ((OLDKEY NEWKEY) ATOM (ITM) ANY)
  20                    <SET ITM <READ .INCHAN '<RETURN>>>
  21                    <COND (<AND <TYPE? .ITM FORM>
  22                                <NOT <EMPTY? .ITM>>
  23                                <TYPE? <1 .ITM> ATOM>>
  24                           <SET NEWKEY <1 .ITM>>)
  25                          (ELSE <SET NEWKEY <TYPE .ITM>>)>
  26                    <SET DENSE <GETPROP .NEWKEY DENSE>>
  27                    <COND (.FIRST-ITEM? <SET FIRST-ITEM? %<>>)
  28                          (ELSE
  29                           <REPEAT ((CRLFS
  30                                     <OR <GETPROP .OLDKEY .NEWKEY>
  31                                         <GETPROP ANY .NEWKEY>
  32                                         <GETPROP .OLDKEY ANY 2>>))
  33                              #DECL ((CRLFS) FIX)
  34                              <COND (<==? .CRLFS 0> <RETURN>)
  35                                    (ELSE
  36                                     <CRLF .OUTCHAN>
  37                                     <SET CRLFS <- .CRLFS 1>>)>>)>
  38                    <EPRIN1 .ITM>
  39                    <SET OLDKEY .NEWKEY>>
  40                 <FLUSH .OUTCHAN>>
  41         <CLOSE .INCHAN>
  42         <AND <CLOSE .OUTCHAN>
  43              <RENAME "TEMP.FORMAT" .OUT-NM>>
  44         "DONE")
  45        (ELSE <CLOSE .INCHAN> #FALSE (Cannot-open-output-file))>
  46       <CLOSE .INCHAN>>)
  47     (ELSE #FALSE (Cannot-open-input-file))>>
  48
  49 <ENDPACKAGE>
  50
  51 <PUTPROP SETG MANIFEST 1>
  52 <PUTPROP SETG SETG 1>
  53 <PUTPROP NEWTYPE SETG 1>
  54 <PUTPROP MSETG SETG 1>
  55 <PUTPROP MSETG MSETG 1>
  56 <PUTPROP SETG MSETG 1>
  57 <PUTPROP NEWTYPE MSETG 1>
  58 <PUTPROP PUTPROP PUTPROP 1>
  59 <PUTPROP GDECL DENSE T>
  60 <PUTPROP MANIFEST DENSE T>
  61 <PUTPROP ENTRY DENSE T>
  62 <PUTPROP RENTRY DENSE T>