File: m3bundle.m3 Last modified on Fri Nov 5 14:46:26 PST 1993 by kalsow
This module implements the M3Bundle
command. See its manpage
for details.
MODULE--------------------------------------------------------- element sizes ---m3bundle EXPORTSMain ; IMPORT Rd, Wr, FileRd, FileWr, OSError, Params, Thread, Fmt, Stdio, Text; <* FATAL Wr.Failure, Rd.Failure, Thread.Alerted, OSError.E *> CONST MaxLineWidth = 75; (* for readability *) MaxBlock = 2000; (* C limits on a TEXT constant *) NL = Wr.EOL; (* line break *) NLNL = NL & NL; TYPE ElementList = REF ARRAY OF Element; Element = RECORD name : TEXT; path : TEXT; base : TEXT; length : INTEGER; blocks : INTEGER; END; VAR elts := NEW (ElementList, 20); n_elts := 0; module : TEXT := NIL; wr : Wr.T := NIL; max_blocks := 0;
PROCEDURE------------------------------------------------------------- interface ---GetElementSizes (): BOOLEAN = VAR rd: Rd.T; ok := TRUE; BEGIN FOR i := 0 TO n_elts-1 DO WITH z = elts[i] DO TRY rd := FileRd.Open (z.path); z.length := Rd.Length (rd); z.blocks := (z.length + MaxBlock - 1) DIV MaxBlock; z.base := "E" & Fmt.Int (i); max_blocks := MAX (max_blocks, z.blocks); Rd.Close (rd); EXCEPT Rd.Failure, OSError.E => wr := Stdio.stderr; Out (Params.Get(0), ": cannot read file: ", z.path, NL); ok := FALSE; END; END; END; RETURN ok; END GetElementSizes;
CONST Intf = "(* Generated by m3bundle; see its manpage. *)" & NLNL & "IMPORT Bundle;" & NLNL & "PROCEDURE Get(): Bundle.T;" & NLNL; PROCEDURE---------------------------------------------------------------- module ---WriteInterface () = BEGIN wr := FileWr.Open (module & ".i3"); Out ("INTERFACE ", module, ";", NL); Out (Intf); Out ("END ", module, ".", NL); Wr.Close (wr); END WriteInterface;
CONST Mod_0 = "(* Generated by m3bundle; see its manpage. *)" & NL & NL & "IMPORT Bundle, BundleRep, Text;" & NL; CONST Mod_1 = "IMPORT Thread, Wr, TextWr;" & NL; CONST Mod_2 = NL & "TYPE T = Bundle.T OBJECT OVERRIDES" & NL & " get := LookUp;" & NL & " getNames := GetNames;" & NL & " END;" & NL & NL & "TYPE Texts = REF ARRAY OF TEXT;" & NL & NL & "VAR" & NL & " bundle: T := NIL;" & NL & " names : Texts := NIL;" & NL & NL & "PROCEDURE Get(): Bundle.T =" & NL & " BEGIN" & NL & " IF (bundle = NIL) THEN bundle := NEW (T) END;" & NL & " RETURN bundle;" & NL & " END Get;" & NL & NL & "PROCEDURE GetNames (<*UNUSED*> self: T): Texts = " & NL & " BEGIN" & NL & " IF names = NIL THEN" & NL & " names := NEW (Texts, NUMBER (Names));" & NL & " names^ := Names;" & NL & " END;" & NL & " RETURN names;" & NL & " END GetNames;" & NL & NL & "PROCEDURE LookUp (<*UNUSED*> self: T; element: TEXT): TEXT = " & NL & " BEGIN" & NL & " FOR i := 0 TO LAST (Names)-1 DO" & NL & " IF Text.Equal (Names[i], element) THEN" & NL; CONST Mod_3 = " IF Elements[i] = NIL THEN Elements[i] := GetElt (i) END;" & NL; CONST Mod_4 = " RETURN Elements[i];" & NL & " END;" & NL & " END;" & NL & " RETURN NIL;" & NL & " END LookUp;" & NL & NL; CONST Mod_5 = "PROCEDURE GetElt (n: INTEGER): TEXT =" & NL & " <*FATAL Thread.Alerted, Wr.Failure *>" & NL & " VAR wr := TextWr.New ();" & NL & " BEGIN" & NL & " CASE n OF" & NL; CONST Mod_6 = " ELSE (*skip*)" & NL & " END;" & NL & " RETURN TextWr.ToText (wr);" & NL & " END GetElt;" & NL & NL; CONST Mod_7 = NL & "BEGIN" & NL & "END "; PROCEDURE-------------------------------------------------- command line parsing ---WriteModule () = BEGIN wr := FileWr.Open (module & ".m3"); Out ("MODULE ", module, ";", NL); Out (Mod_0); IF (max_blocks > 1) THEN Out (Mod_1) END; Out (Mod_2); IF (max_blocks > 1) THEN Out (Mod_3) END; Out (Mod_4); WriteNames (); WriteElements (); IF (max_blocks > 1) THEN Out (Mod_5); WriteGetElt (); Out (Mod_6); END; WriteLiterals (); Out (Mod_7, module, ".", NL); Wr.Close (wr) END WriteModule; PROCEDUREWriteGetElt () = BEGIN FOR i := 0 TO n_elts-1 DO WITH z = elts[i] DO IF (z.blocks > 1) THEN Out (" | ", Fmt.Int (i), " =>", NL); FOR j := 0 TO z.blocks-1 DO Out (" Wr.PutText (wr, ", BlockName (z.base, j), ");", NL); END; END; END; END; END WriteGetElt; PROCEDUREWriteNames () = VAR name: TEXT; BEGIN Out ("CONST Names = ARRAY [0..", Fmt.Int (n_elts), "] OF TEXT {", NL); FOR i := 0 TO n_elts-1 DO IF (i > 0) THEN Out (",", NL) END; name := elts[i].name; Out (" \""); FOR j := 0 TO Text.Length (name) - 1 DO EVAL OutChar (Text.GetChar (name, j)); END; Out ("\""); END; IF (n_elts > 0) THEN Out (",", NL) END; Out (" NIL", NL, "};", NLNL); END WriteNames; PROCEDUREWriteElements () = BEGIN IF (max_blocks > 1) THEN Out ("VAR Elements :="); ELSE Out ("CONST Elements ="); END; Out (" ARRAY [0..", Fmt.Int (n_elts), "] OF TEXT {", NL); FOR i := 0 TO n_elts-1 DO IF (i > 0) THEN Out (",", NL) END; WITH z = elts[i] DO IF (z.length <= 0) THEN Out (" \"\""); ELSIF (z.blocks <= 1) THEN Out (" ", BlockName (z.base, 0)); ELSE (* fill it in at runtime by calling GetElt *) Out (" NIL (* ", BlockName (z.base, 0), " .. "); Out (BlockName (z.base, z.blocks-1), " *)"); END; END; END; IF (n_elts > 0) THEN Out (",", NL) END; Out (" NIL", NL, "};", NLNL); END WriteElements; PROCEDUREWriteLiterals () = VAR rd: Rd.T; BEGIN FOR i := 0 TO n_elts-1 DO WITH z = elts[i] DO rd := FileRd.Open (z.path); WriteLiteral (rd, z.base); Rd.Close (rd); END; END; END WriteLiterals; PROCEDUREWriteLiteral (rd: Rd.T; base: TEXT) = <*FATAL Rd.EndOfFile*> VAR width, bytes, blocks := 0; ch: CHAR; BEGIN WHILE NOT Rd.EOF (rd) DO IF (bytes = 0) THEN (* start a new block *) Out ("CONST ", BlockName (base, blocks), " = \n \""); INC (blocks); width := 4; ELSIF (width = 0) THEN (* start a new line *) Out (" & \""); width := 4; END; (* write a character *) ch := Rd.GetChar (rd); INC (width, OutChar (ch)); INC (bytes); IF (bytes >= MaxBlock) THEN (* finish this block *) Out ("\";", NLNL); bytes := 0; width := 0; ELSIF (width >= MaxLineWidth) THEN (* finish this line *) Out ("\"", NL); width := 0; END; END; IF (width > 0) THEN (* finish the last string *) Out ("\"") END; IF (bytes > 0) THEN (* finish the last block *) Out (";", NLNL) END; END WriteLiteral; PROCEDUREBlockName (base: TEXT; block: INTEGER): TEXT = BEGIN IF (block = 0) THEN RETURN base END; RETURN base & "_" & Fmt.Int (block - 1); END BlockName;
PROCEDURE--------------------------------------------------------- low-level I/O ---ParseCommandLine (): BOOLEAN = VAR next := 0; PROCEDURE NextParam (): TEXT = BEGIN INC (next); IF (next >= Params.Count) THEN RETURN NIL END; RETURN Params.Get (next); END NextParam; BEGIN IF ParseOptions (NextParam) THEN RETURN TRUE END; wr := Stdio.stderr; Out ("usage: ", Params.Get (0), " -name n [-element e path] ...", NL); RETURN FALSE; END ParseCommandLine; PROCEDUREParseOptions (next_arg: PROCEDURE (): TEXT): BOOLEAN = VAR arg: TEXT; BEGIN LOOP arg := next_arg (); IF (arg = NIL) THEN RETURN module # NIL; ELSIF Text.Equal (arg, "-name") THEN module := next_arg (); IF (module = NIL) THEN RETURN FALSE END; ELSIF Text.Equal (arg, "-element") THEN IF (n_elts > LAST (elts^)) THEN ExpandElts () END; WITH z = elts[n_elts] DO z.name := next_arg (); z.path := next_arg (); IF (z.name = NIL) OR (z.path = NIL) THEN RETURN FALSE END; END; INC (n_elts); ELSIF Text.Equal (Text.Sub (arg, 0, 2), "-F") THEN IF NOT ParseOptionFile (Text.Sub (arg, 2, LAST (CARDINAL))) THEN RETURN FALSE; END; ELSE RETURN FALSE; END; END; END ParseOptions; PROCEDUREParseOptionFile (name: TEXT): BOOLEAN = <* FATAL Rd.EndOfFile *> VAR f := FileRd.Open (name); b: BOOLEAN; PROCEDURE NextLine (): TEXT = BEGIN IF Rd.EOF (f) THEN RETURN NIL END; RETURN Rd.GetLine (f); END NextLine; BEGIN b := ParseOptions (NextLine); Rd.Close(f); RETURN b; END ParseOptionFile; PROCEDUREExpandElts () = VAR new := NEW (ElementList, 2 * NUMBER (elts^)); BEGIN FOR i := 0 TO LAST (elts^) DO new[i] := elts[i] END; elts := new; END ExpandElts;
PROCEDURE------------------------------------------------------------- main body ---Out (a, b, c, d: TEXT := NIL) = BEGIN IF (a # NIL) THEN Wr.PutText (wr, a) END; IF (b # NIL) THEN Wr.PutText (wr, b) END; IF (c # NIL) THEN Wr.PutText (wr, c) END; IF (d # NIL) THEN Wr.PutText (wr, d) END; END Out; PROCEDUREOutChar (ch: CHAR): INTEGER = (* writes 'ch' as a literal and returns the output width *) BEGIN IF (ch = '\\') THEN Wr.PutText (wr, "\\\\"); RETURN 2; ELSIF (ch = '\n') THEN Wr.PutText (wr, "\\n"); RETURN 2; ELSIF (ch = '\r') THEN Wr.PutText (wr, "\\r"); RETURN 2; ELSIF (ch = '\t') THEN Wr.PutText (wr, "\\t"); RETURN 2; ELSIF (ch = '\f') THEN Wr.PutText (wr, "\\f"); RETURN 2; ELSIF (ch = '\'') THEN Wr.PutText (wr, "\\\'"); RETURN 2; ELSIF (ch = '\"') THEN Wr.PutText (wr, "\\\""); RETURN 2; ELSIF (ch < ' ') OR (ch > '~') THEN Wr.PutChar (wr, '\\'); PutC (ORD(ch) DIV 64); PutC (ORD(ch) MOD 64 DIV 8); PutC (ORD(ch) MOD 8); RETURN 4; ELSE Wr.PutChar (wr, ch); RETURN 1; END; END OutChar; PROCEDUREPutC (i: INTEGER) = BEGIN Wr.PutChar (wr, VAL(ORD('0') + i, CHAR)); END PutC;
BEGIN IF ParseCommandLine () AND GetElementSizes () THEN WriteInterface (); WriteModule (); END; END m3bundle.