(* Copyright (C) 1992, Digital Equipment Corporation *) (* All rights reserved. *) (* See the file COPYRIGHT for a full description. *) (* File: Main.m3 *) (* Last modified on Fri Jan 15 09:47:27 PST 1993 by kalsow *) (* modified on Tue Nov 10 11:21:26 PST 1992 by muller *) MODULE Main; (* TO DO: - do not wait for the result of the compilation of modules; use a crew of processes *) IMPORT Text, Rd, Wr, Stdio, TextSet; IMPORT FileStream, Fmt, TxtRefTbl; IMPORT Filename, DriverConfig, OS, M3Linker; IMPORT RTHeap, Thread, ETimer, Scan; <*FATAL Wr.Failure, Thread.Alerted, Rd.Failure, Rd.EndOfFile*> TYPE MsgLevel = {Silent, Explain, Commands, Verbose, Debug}; TYPE ArgList = REF RECORD head, tail: ArgNode := NIL; cnt := 0 END; ArgNode = REF RECORD arg: TEXT; next: ArgNode END; TYPE FileType = { I3, IC, IS, IO, IG, M3, MC, MS, MO, MG, C, H, S, O, A, B, Unknown }; CONST FileSuffix = ARRAY FileType OF TEXT { ".i3", ".ic", ".is", ".io", ".ig", ".m3", ".mc", ".ms", ".mo", ".mg", ".c", ".h", ".s", ".o", ".a", ".b", "" }; VAR (** now : INTEGER := OS.Now(); **) latest_obj : INTEGER := OS.NO_TIME; VAR n_targets : INTEGER := 0; lib_name : TEXT := NIL; pgm_name : TEXT := NIL; compile_failed: BOOLEAN := FALSE; split_name : TEXT := NIL; base_pgm : TEXT := NIL; builtin_name : M3Linker.NameList := NIL; VAR msg_level : MsgLevel := MsgLevel.Silent; warning_level : INTEGER := 3; warning_arg : TEXT := "-w3"; server_limit : INTEGER := 0; server : OS.Handle := NIL; make_mode : BOOLEAN := FALSE; skip_std_lib : BOOLEAN := FALSE; compile_to_O : BOOLEAN := FALSE; compile_to_C : BOOLEAN := FALSE; compile_to_S : BOOLEAN := FALSE; keep_files : BOOLEAN := FALSE; dump_config : BOOLEAN := FALSE; do_coverage : BOOLEAN := FALSE; keep_resolved : BOOLEAN := FALSE; cc_paranoid : BOOLEAN := FALSE; bootstrap_mode: BOOLEAN := FALSE; build_base : BOOLEAN := FALSE; search_path : BOOLEAN := FALSE; cleaning : BOOLEAN := FALSE; VAR pass_0_args : ArgList := NEW (ArgList); pass_0 : TEXT := "*UNDEFINED*"; pass_1_args : ArgList := NEW (ArgList); pass_1 : TEXT := "*UNDEFINED*"; pass_2_args : ArgList := NEW (ArgList); pass_2 : TEXT := "*UNDEFINED*"; pass_3_args : ArgList := NEW (ArgList); pass_3 : TEXT := "*UNDEFINED*"; pass_4_args : ArgList := NEW (ArgList); pass_4 : TEXT := "*UNDEFINED*"; pass_5_args : ArgList := NEW (ArgList); pass_5 : TEXT := "*UNDEFINED*"; base_args : ArgList := NEW (ArgList); overlay0_args : ArgList := NEW (ArgList); overlay1_args : ArgList := NEW (ArgList); link_files : TEXT := NIL; cc_debug : TEXT := NIL; cc_optimize : TEXT := NIL; include_dir : TEXT := NIL; link_coverage : TEXT := NIL; VAR def_path : ArgList := NEW (ArgList); include_path : ArgList := NEW (ArgList); lib_path : ArgList := NEW (ArgList); VAR interfaces := NEW (ArgList); ic_sources := NEW (ArgList); is_sources := NEW (ArgList); io_sources := NEW (ArgList); o_sources := NEW (ArgList); modules := NEW (ArgList); mc_sources := NEW (ArgList); ms_sources := NEW (ArgList); mo_sources := NEW (ArgList); c_sources := NEW (ArgList); h_sources := NEW (ArgList); asm_sources := NEW (ArgList); objects := NEW (ArgList); libraries := NEW (ArgList); lib_dirs := NEW (ArgList); VAR intf_map := TxtRefTbl.New (100); h_map := TxtRefTbl.New (100); lib_pool := TxtRefTbl.New (100); lib_impls := TxtRefTbl.New (100); intf_dirs := TextSet.New (100); h_dirs := TextSet.New (100); tmp_files := TextSet.New (100); checked := TextSet.New (100); link_base : M3Linker.LinkSet := NIL; link_units : M3Linker.UnitList := NIL; local_units : M3Linker.UnitList := NIL; VAR copy_timer : ETimer.T := NIL; clone_timer : ETimer.T := NIL; rename_timer : ETimer.T := NIL; remove_timer : ETimer.T := NIL; pass4_timer : ETimer.T := NIL; pass3_timer : ETimer.T := NIL; exhale_timer : ETimer.T := NIL; libmerge_timer : ETimer.T := NIL; pass5_timer : ETimer.T := NIL; pass2_timer : ETimer.T := NIL; genMain_timer : ETimer.T := NIL; genLib_timer : ETimer.T := NIL; chkpgm_timer : ETimer.T := NIL; pass1_timer : ETimer.T := NIL; merge_timer : ETimer.T := NIL; stop_p0_timer : ETimer.T := NIL; pass0_timer : ETimer.T := NIL; start_p0_timer : ETimer.T := NIL; stalem3_timer : ETimer.T := NIL; staleobj_timer : ETimer.T := NIL; inhale_timer : ETimer.T := NIL; path_timer : ETimer.T := NIL; (*------------------------------------------------------------------ main ---*) PROCEDURE DoIt () = BEGIN SetupSignalHandlers (); ParseCommandLine (); builtin_name := NEW (M3Linker.NameList, next := NIL); builtin_name.name.text := M3Linker.BuiltinUnitName; IF (split_name # NIL) THEN SplitLibrary (); ELSE BuildSearchPaths (); RTHeap.GCOff (); BuildLibraryPool (); FindFixedVersionStamps (); RTHeap.GCOn (); CompileEverything (); END; IF (pgm_name # NIL) THEN BuildProgram (); ELSIF (lib_name # NIL) THEN BuildLibrary (); END; CleanUp (); StopTimers (); IF (compile_failed) THEN OS.Exit (-1) END; END DoIt; (*------------------------------------------------------ signal handling ---*) PROCEDURE SetupSignalHandlers () = BEGIN OS.OnShutDown (CleanUp); END SetupSignalHandlers; PROCEDURE CleanUp () = VAR files := NEW (ArgList); key: TEXT; n: ArgNode; BEGIN IF cleaning THEN RETURN END; cleaning := TRUE; StopServer (FALSE); EVAL tmp_files.enumerate (NoteFile, files, key); n := files.head; WHILE (n # NIL) DO Remove (n.arg); n := n.next; END; END CleanUp; PROCEDURE NoteFile (arg: REFANY; value: TEXT): BOOLEAN = VAR list: ArgList := arg; BEGIN Append (list, value); RETURN FALSE; END NoteFile; (*------------------------------------------------- command line parsing ---*) PROCEDURE ParseCommandLine () = VAR args := NEW (ArgList); z := DriverConfig.GetArgs (); BEGIN (* build the initial argument list *) FOR i := 0 TO LAST (z^) DO Append (args, z[i]); END; FOR i := 1 TO OS.NumParameters() - 1 DO Append (args, OS.GetParameter (i)); END; (* parse the argument list *) ParseArgList (args); IF (pgm_name # NIL) AND (ClassifyName (pgm_name) = FileType.B) THEN build_base := TRUE; END; IF (NOT skip_std_lib) AND (base_pgm = NIL) THEN (* add the standard libraries as arguments *) ParseArgList (GetChunks (link_files)); END; IF (dump_config) THEN DumpConfiguration (); StopTimers (); OS.Exit (0); ELSIF (n_targets = 0) THEN pgm_name := "a.out"; ELSIF (n_targets > 1) THEN UsageError ("Only one of -c, -o, -a, -C, -S, -split can be specified"); END; IF (build_base) AND (base_pgm # NIL) THEN UsageError ("cannot build a base program on another: ", base_pgm); END; END ParseCommandLine; PROCEDURE ParseFileArgs (file: TEXT) = VAR rd: Rd.T; args := NEW (ArgList); BEGIN TRY rd := FileStream.OpenRead (file); EXCEPT Rd.Failure => rd := NIL; END; IF (rd = NIL) THEN FatalError ("unable to open argument file: ", file); END; WHILE NOT Rd.EOF (rd) DO Append (args, Trim (Rd.GetLine (rd))); END; Rd.Close (rd); ParseArgList (args); END ParseFileArgs; PROCEDURE ParseArgList (list: ArgList) = VAR len: INTEGER; arg: TEXT; BEGIN WHILE (list.cnt > 0) DO arg := PopArg (list); len := Text.Length (arg); IF (len < 1) THEN (* empty argument ignore *) ELSIF (Text.GetChar (arg, 0) # '-') OR (len < 2) THEN AddSourceFile ("", arg, cmd_line := TRUE); ELSE (* it's an option *) ParseOption (arg, len, list); END; END; END ParseArgList; PROCEDURE ParseOption (arg: TEXT; arg_len: INTEGER; rest: ArgList) = VAR ok := FALSE; dir: TEXT; BEGIN CASE Text.GetChar (arg, 1) OF | '?' => IF (arg_len = 2) THEN dump_config := TRUE; ok := TRUE; END; | 'a' => IF (arg_len = 2) THEN lib_name := GetArg (arg, rest); INC (n_targets); ok := TRUE; END; | 'A' => IF (arg_len = 2) THEN Append (pass_0_args, "-a"); ok := TRUE; END; | 'b' => IF Text.Equal (arg, "-boot") THEN bootstrap_mode := TRUE; skip_std_lib := TRUE; ok := TRUE; END; | 'c' => IF (arg_len = 2) THEN compile_to_O := TRUE; INC (n_targets); ok := TRUE; ELSIF Text.Equal (arg, "-commands") THEN SetMsgLevel (MsgLevel.Commands); ok := TRUE; ELSIF Text.Equal (arg, "-config") THEN dump_config := TRUE; ok := TRUE; END; | 'C' => IF (arg_len = 2) THEN compile_to_C := TRUE; INC (n_targets); ok := TRUE; END; | 'd' => IF (arg_len = 2) THEN Append (pass_0_args, arg); ok := TRUE; ELSIF Text.Equal (arg, "-debug") THEN SetMsgLevel (MsgLevel.Debug); StartTimers (); ok := TRUE; END; | 'D' => IF (arg_len = 2) THEN def_path := NEW (ArgList); ELSE PushPath (def_path, Text.Sub (arg, 2, arg_len)); END; ok := TRUE; | 'F' => IF (arg_len > 2) THEN ParseFileArgs (Text.Sub (arg, 2, arg_len)); ok := TRUE; END; | 'g' => IF (arg_len = 2) THEN AppendL (pass_1_args, GetChunks (cc_debug)); ELSE Append (pass_1_args, arg); END; ok := TRUE; | 'k' => IF (arg_len = 2) OR Text.Equal (arg, "-keep") THEN keep_files := TRUE; ok := TRUE; END; | 'L' => IF (arg_len = 2) THEN lib_path := NEW (ArgList); ELSE PushPath (lib_path, Text.Sub (arg, 2, arg_len)); END; ok := TRUE; | 'l' => IF (arg_len > 2) THEN Append (libraries, ResolveLib (Text.Sub(arg, 2, arg_len), dir)); Append (lib_dirs, dir); ok := TRUE; END; | 'm' => IF Text.Equal (arg, "-make") THEN (** SetMsgLevel (MsgLevel.Explain); **) make_mode := TRUE; ok := TRUE; END; | 'n' => IF Text.Equal (arg, "-nostd") THEN skip_std_lib := TRUE; ok := TRUE; ELSIF Text.Equal (arg, "-noflatten") THEN search_path := TRUE; ok := TRUE; END; | 'o' => IF (arg_len = 2) THEN pgm_name := GetArg (arg, rest); INC (n_targets); ok := TRUE; END; | 'O' => IF (arg_len = 2) THEN AppendL (pass_1_args, GetChunks (cc_optimize)); ELSE Append (pass_1_args, arg); END; ok := TRUE; | 's' => IF Text.Equal (arg, "-silent") THEN SetMsgLevel (MsgLevel.Silent); ok := TRUE; ELSIF Text.Equal (arg, "-split") THEN split_name := GetArg (arg, rest); INC (n_targets); ok := TRUE; END; | 'S' => IF (arg_len = 2) THEN compile_to_S := TRUE; INC (n_targets); ok := TRUE; END; | 't' => IF Text.Equal (arg, "-times") THEN StartTimers (); ok := TRUE; END; | 'v' => IF Text.Equal (arg, "-verbose") THEN SetMsgLevel (MsgLevel.Verbose); StartTimers (); ok := TRUE; ELSIF (arg_len = 2) THEN SetMsgLevel (MsgLevel.Verbose); StartTimers (); warning_level := 0; warning_arg := "-w0"; ok := TRUE; END; | 'w' => IF Text.Equal (arg, "-why") THEN SetMsgLevel (MsgLevel.Explain); ok := TRUE; ELSIF Text.Equal (arg, "-w0") THEN SetWarning (0, arg); ok := TRUE; ELSIF Text.Equal (arg, "-w1") THEN SetWarning (1, arg); ok := TRUE; ELSIF Text.Equal (arg, "-w2") THEN SetWarning (2, arg); ok := TRUE; ELSIF Text.Equal (arg, "-w3") THEN SetWarning (3, arg); ok := TRUE; END; | 'X' => IF (arg_len > 3) THEN ok := TRUE; CASE Text.GetChar (arg, 2) OF | '0' => GetArgs (pass_0_args, arg); | '1' => GetArgs (pass_1_args, arg); | '2' => GetArgs (pass_2_args, arg); | '3' => GetArgs (pass_3_args, arg); | '4' => GetArgs (pass_4_args, arg); ELSE (*error*) ok := FALSE; END; END; | 'Y' => IF (arg_len > 3) THEN ok := TRUE; CASE Text.GetChar (arg, 2) OF | '0' => pass_0 := GetPass (pass_0_args, arg); | '1' => pass_1 := GetPass (pass_1_args, arg); | '2' => pass_2 := GetPass (pass_2_args, arg); | '3' => pass_3 := GetPass (pass_3_args, arg); | '4' => pass_4 := GetPass (pass_4_args, arg); | '5' => pass_5 := GetPass (pass_5_args, arg); ELSE (*error*) ok := FALSE; END; END; | 'Z' => IF (arg_len = 2) THEN Append (pass_0_args, arg); ok := TRUE; do_coverage := TRUE; END; | 'z' => IF (arg_len > 3) THEN ok := TRUE; CASE Text.GetChar (arg, 2) OF | '0' => cc_optimize := arg; | '1' => cc_debug := arg; | '2' => link_files := arg; | '3' => link_coverage := Text.Sub (arg, 3, arg_len); | '4' => include_dir := Text.Sub (arg, 3, arg_len); | '5' => cc_paranoid := (Text.GetChar (arg, 3) # '0'); | '6' => keep_resolved := (Text.GetChar (arg, 3) # '0'); | '7' => GetArgs (base_args, arg); | '8' => GetArgs (overlay0_args, arg); | '9' => GetArgs (overlay1_args, arg); | 'A' => server_limit := ToInt (Text.Sub (arg, 3, arg_len)); ELSE (*error*) ok := FALSE; END; END; ELSE (* error *) END; IF (NOT ok) THEN UsageError ("unrecognized option \'", arg, "\'") END; END ParseOption; PROCEDURE GetArg (arg: TEXT; rest: ArgList): TEXT = BEGIN IF (rest.cnt <= 0) THEN UsageError ("missing argument to \'", arg, "\' option"); END; RETURN PopArg (rest); END GetArg; PROCEDURE SetMsgLevel (level: MsgLevel) = BEGIN msg_level := MAX (msg_level, level); END SetMsgLevel; PROCEDURE SetWarning (level: INTEGER; arg: TEXT) = BEGIN IF (level < warning_level) THEN warning_level := level; warning_arg := arg; END; END SetWarning; PROCEDURE ToInt (t: TEXT): INTEGER = VAR i := 0; BEGIN TRY i := Scan.Int (t); EXCEPT Scan.BadFormat => UsageError ("bad integer"); END; RETURN i; END ToInt; PROCEDURE GetPass (args: ArgList; value: TEXT): TEXT = VAR list := GetChunks (value); n: ArgNode; prog: TEXT; BEGIN (* reset the pass *) prog := NIL; args.head := NIL; args.tail := NIL; args.cnt := 0; IF (list.cnt > 0) THEN prog := list.head.arg; n := list.head.next; WHILE (n # NIL) DO Append (args, n.arg); n := n.next END; END; RETURN prog; END GetPass; PROCEDURE GetArgs (args: ArgList; value: TEXT) = BEGIN AppendL (args, GetChunks (value)); END GetArgs; PROCEDURE GetChunks (value: TEXT): ArgList = (* extract the Ai in '-Xn/A1/A2/.../An/' *) VAR i, j: INTEGER; len := Text.Length (value); dot: CHAR; result := NEW (ArgList); BEGIN IF (len < 5) THEN FatalError ("improperly formatted argument: ", value); END; dot := Text.GetChar (value, 3); IF Text.GetChar (value, len-1) # dot THEN FatalError ("improperly formatted argument: ", value); END; j := 4; WHILE (j < len) DO i := j; WHILE (j < len) AND Text.GetChar (value, j) # dot DO INC (j) END; Append (result, Text.Sub (value, i, (j-i))); INC (j); END; RETURN result; END GetChunks; PROCEDURE PushPath (path: ArgList; new: TEXT) = VAR x := Text.Length (new)-1; y: INTEGER; BEGIN WHILE (x >= 0) DO y := x; WHILE (x >= 0) AND (Text.GetChar (new, x) # ':') DO DEC (x) END; IF (x < y) THEN Prepend (path, Text.Sub (new, x+1, y-x)) END; DEC (x); END; END PushPath; PROCEDURE UsageError (a, b, c: TEXT := NIL) = BEGIN Out (a, b, c, "\n"); Out ("usage: ", OS.GetParameter(0)); Out (" [-?] [options] [-o pgm|-a lib|-c] "); Out ("sources... objs... libs...\n"); FatalError ("bad usage"); END UsageError; PROCEDURE Trim (t: TEXT): TEXT = VAR start := 0; len := Text.Length (t); BEGIN WHILE (len > 0) AND (Text.GetChar (t, start) = ' ') DO INC (start); DEC (len); END; WHILE (len > 0) AND (Text.GetChar (t, start+len-1) = ' ') DO DEC (len); END; RETURN Text.Sub (t, start, len); END Trim; (*--------------------------------------------------------- help/config ---*) PROCEDURE DumpConfiguration () = CONST Bool = ARRAY BOOLEAN OF TEXT { "FALSE", "TRUE" }; BEGIN OutL ("pass 0 := ", pass_0, pass_0_args); OutL ("pass 1 := ", pass_1, pass_1_args); OutL ("pass 2 := ", pass_2, pass_2_args); OutL ("pass 2 base := ", NIL, base_args); OutL ("pass 3 := ", pass_3, pass_3_args); OutL ("pass 4 := ", pass_4, pass_4_args); OutL ("pass 5 := ", pass_5, pass_5_args); OutL ("pass 5 mid := ", NIL, overlay0_args); OutL ("pass 5 tail := ", NIL, overlay1_args); OutL ("def path := ", NIL, def_path); OutL ("lib path := ", NIL, lib_path); Out ("include := ", include_dir, "\n"); Out ("server limit := ", Fmt.Int (server_limit), " megabytes\n"); Out ("make mode := ", Bool [make_mode], "\n"); Out ("bootstrap := ", Bool [bootstrap_mode], "\n"); Out ("std libs := ", Bool [NOT skip_std_lib]); OutL (" ", NIL, GetChunks (link_files)); Out ("keep files := ", Bool [keep_files], "\n"); Out ("coverage := ", Bool [do_coverage], " ", link_coverage, "\n"); Out ("resolve libs := ", Bool [keep_resolved], "\n"); Out ("CC paranoid := ", Bool [cc_paranoid], "\n"); OutL ("-O => ", NIL, GetChunks (cc_optimize)); OutL ("-g => ", NIL, GetChunks (cc_debug)); END DumpConfiguration; (*-------------------------------------------------------------- timers ---*) PROCEDURE StartTimers () = (* note: we allocate the timers in reverse order of printout *) BEGIN IF (pass0_timer # NIL) THEN RETURN END; copy_timer := ETimer.New ("copying files"); clone_timer := ETimer.New ("cloning (linking) files"); rename_timer := ETimer.New ("renaming files"); remove_timer := ETimer.New ("removing temporary files"); pass4_timer := ETimer.New ("indexing library archive"); pass3_timer := ETimer.New ("building library archive"); exhale_timer := ETimer.New ("exhaling new link info"); libmerge_timer := ETimer.New ("building library link info"); pass5_timer := ETimer.New ("linking overlay"); pass2_timer := ETimer.New ("linking"); genMain_timer := ETimer.New ("generating _m3main.c"); genLib_timer := ETimer.New ("generating _m3lib.c"); chkpgm_timer := ETimer.New ("checking global consistency"); pass1_timer := ETimer.New ("compiling C -> object"); merge_timer := ETimer.New ("merging new link info"); stop_p0_timer := ETimer.New ("stopping compile server"); pass0_timer := ETimer.New ("compiling Modula-3 -> C"); start_p0_timer := ETimer.New ("starting compile server"); stalem3_timer := ETimer.New ("checking old link info"); staleobj_timer := ETimer.New ("checking object timestamps"); inhale_timer := ETimer.New ("inhaling library link info"); path_timer := ETimer.New ("flattening search path"); ETimer.Enable (); END StartTimers; PROCEDURE StopTimers () = BEGIN IF (pass0_timer # NIL) THEN ETimer.Dump (Stdio.stdout) END; END StopTimers; (*-------------------------------------------------------- source files ---*) PROCEDURE AddSourceFile (dir, name: TEXT; cmd_line := FALSE) = TYPE F = FileType; VAR type := ClassifyName (name); VAR file := dir & name; BEGIN IF (type # F.Unknown) THEN Verbose ("using ", name) END; CASE type OF | F.I3 => Append (interfaces, file); AddInterface (file); | F.IC => Append (ic_sources, file); | F.IS => Append (is_sources, file); | F.IO => Append (io_sources, file); | F.IG => Verbose ("ignoring ", file); AddGeneric (file); | F.M3 => Append (modules, file); | F.MC => Append (mc_sources, file); | F.MS => Append (ms_sources, file); | F.MO => Append (mo_sources, file); | F.MG => Verbose ("ignoring ", file); AddGeneric (file); | F.C => Append (c_sources, file); | F.H => Append (h_sources, file); AddH (file); | F.S => Append (asm_sources, file); | F.O => Append (o_sources, file); | F.A => Append (libraries, file); Append (lib_dirs, NIL); | F.B => SetBaseProgram (file); ELSE VisitSourceDir (dir, name, cmd_line); END; END AddSourceFile; PROCEDURE AddInterface (file: TEXT) = VAR ref: REFANY; old: TEXT; len := Text.Length (file); key := Filename.Tail (file); head := len - Text.Length (key) - 1(*slash*); BEGIN IF NOT intf_map.in (key, ref) THEN EVAL intf_map.put (key, file); IF (head > 0) THEN EVAL intf_dirs.put (Text.Sub (file, 0, head)); ELSE EVAL intf_dirs.put ("."); END; ELSE old := ref; IF NOT Text.Equal (file, old) THEN FatalError ("duplicate interface: "& key, "\n "& file &"\n "& old); END; END; END AddInterface; PROCEDURE AddGeneric (file: TEXT) = VAR len := Text.Length (file); key := Filename.Tail (file); head := len - Text.Length (key) - 1(*slash*); BEGIN IF (head > 0) THEN EVAL intf_dirs.put (Text.Sub (file, 0, head)); ELSE EVAL intf_dirs.put ("."); END; END AddGeneric; PROCEDURE AddH (file: TEXT) = VAR ref: REFANY; old: TEXT; len := Text.Length (file); key := Filename.Tail (file); head := len - Text.Length (key) - 1(*slash*); BEGIN IF NOT h_map.in (key, ref) THEN EVAL h_map.put (key, file); IF (head > 0) THEN EVAL h_dirs.put (Text.Sub (file, 0, head)); ELSE EVAL h_dirs.put ("."); END; ELSE old := ref; IF NOT Text.Equal (file, old) THEN FatalError ("duplicate .h file: "& key, "\n "& file &"\n "& old); END; END; END AddH; PROCEDURE AddObject (file: TEXT) = BEGIN Debug ("adding object: ", file, "\n"); Append (objects, file); latest_obj := MAX (latest_obj, OS.CreateTime (file)); END AddObject; PROCEDURE SetBaseProgram (file: TEXT) = BEGIN IF (base_pgm # NIL) THEN UsageError ("cannot only specify two base programs: ", file); END; base_pgm := file; END SetBaseProgram; PROCEDURE VisitSourceDir (dir, name: TEXT; cmd_line: BOOLEAN) = VAR d := OS.OpenDir (dir & name); BEGIN IF d = NIL THEN IF (cmd_line) THEN FatalError ("unsupported file type \"", dir & name, "\""); END; Verbose ("ignoring ", dir & name); RETURN END; dir := dir & name & "/"; Verbose ("Looking in ", dir); LOOP name := OS.ReadDir (d); IF name = NIL THEN EXIT END; IF NOT (Text.Equal (name, ".") OR Text.Equal (name, "..")) THEN AddSourceFile (dir, name, cmd_line := FALSE); END; END; OS.CloseDir (d); END VisitSourceDir; (*----------------------------------------------------------- search path ---*) PROCEDURE BuildSearchPaths () = VAR key: TEXT; n: ArgNode; reverse_def_path := NEW (ArgList); reverse_include_path := NEW (ArgList); BEGIN (* build the Modula-3 search path *) EVAL intf_dirs.enumerate (AddToSearchPath, NIL, key); (* build the reverse search path *) n := def_path.head; WHILE (n # NIL) DO Prepend (reverse_def_path, "-D" & n.arg); n := n.next; END; IF (reverse_def_path.cnt > 1) AND (NOT search_path) THEN ETimer.Push (path_timer); Append (pass_0_args, "-T" & BuildImportFile (def_path, ".m3imports")); ETimer.Pop (); ELSIF (reverse_def_path.cnt <= 5) THEN AppendL (pass_0_args, reverse_def_path); ELSE Append (pass_0_args, "-F" & BuildArgFile (reverse_def_path, ".m3path")); END; (* build the include path *) EVAL h_dirs.enumerate (AddToIncludePath, NIL, key); EVAL AddToIncludePath (NIL, include_dir); n := include_path.head; WHILE (n # NIL) DO Prepend (reverse_include_path, "-I" & n.arg); n := n.next; END; AppendL (pass_1_args, reverse_include_path); END BuildSearchPaths; PROCEDURE AddToSearchPath (<*UNUSED*> data: REFANY; dir: TEXT): BOOLEAN = BEGIN IF (Text.Length (dir) > 0) THEN Prepend (def_path, dir) END; RETURN FALSE; END AddToSearchPath; PROCEDURE AddToIncludePath (<*UNUSED*> data: REFANY; dir: TEXT): BOOLEAN = BEGIN IF (Text.Length (dir) > 0) THEN Prepend (include_path, dir) END; RETURN FALSE; END AddToIncludePath; PROCEDURE BuildArgFile (list: ArgList; root: TEXT): TEXT = VAR n: ArgNode; file: TEXT; wr := OpenTempFile (root, file); BEGIN n := list.head; WHILE (n # NIL) DO Wr.PutText (wr, n.arg); Wr.PutChar (wr, '\n'); n := n.next; END; Wr.Close (wr); RETURN file; END BuildArgFile; PROCEDURE BuildImportFile (list: ArgList; root: TEXT): TEXT = VAR n: ArgNode; file: TEXT; dir: TEXT; wr := OpenTempFile (root, file); map := TextSet.New (100); BEGIN EVAL map.put ("."); EVAL map.put (".."); n := list.head; WHILE (n # NIL) DO dir := n.arg; Wr.PutChar (wr, '@'); Wr.PutText (wr, dir); Wr.PutChar (wr, '\n'); AddImports (wr, map, dir); n := n.next; END; Wr.Close (wr); RETURN file; END BuildImportFile; PROCEDURE AddImports (wr: Wr.T; map: TextSet.T; dir: TEXT) = VAR d := OS.OpenDir (dir); kind: FileType; name: TEXT; BEGIN IF (d = NIL) THEN FatalError ("cannot open directory on search path: ", dir); RETURN END; Verbose ("flattening directory: ", dir); LOOP name := OS.ReadDir (d); IF name = NIL THEN EXIT END; IF NOT map.put (name) THEN (* this is the first instance of the name *) kind := ClassifyName (name); IF (kind = FileType.I3) OR (kind = FileType.IG) OR (kind = FileType.MG) THEN Wr.PutText (wr, name); Wr.PutChar (wr, '\n'); Verbose (" adding ", name); END; END; END; OS.CloseDir (d); END AddImports; PROCEDURE OpenTempFile (root: TEXT; VAR file: TEXT): Wr.T = VAR seq := 0; wr: Wr.T; BEGIN file := root; WHILE (OS.CreateTime (file) # OS.NO_TIME) DO INC (seq); file := root & "_" & Fmt.Int (seq); END; TRY wr := FileStream.OpenWrite (file); EXCEPT Wr.Failure => wr := NIL; END; IF (wr = NIL) THEN FatalError ("unable to open temporary file: ", file); <*ASSERT FALSE*> END; EVAL tmp_files.put (file); RETURN wr; END OpenTempFile; (*---------------------------------------------------------- library pool ---*) PROCEDURE BuildLibraryPool () = VAR a := libraries.head; ux: M3Linker.UnitList; BEGIN WHILE (a # NIL) DO ETimer.Push (inhale_timer); Commands ("inhale ", a.arg); ux := GetLinkUnits (a.arg, FileType.A, imported := TRUE, optional := TRUE, quiet := FALSE); IF (ux # NIL) THEN Debug ("adding units: "); AddLibraryPool (ux); ELSE Debug ("no link info for ", a.arg, "\n"); END; Debug ("\n"); a := a.next; ETimer.Pop (); END; IF (base_pgm # NIL) THEN (* add the units from the base *) ETimer.Push (inhale_timer); Commands ("inhale ", base_pgm); ux := GetLinkUnits (base_pgm, FileType.B, imported := TRUE, optional := FALSE, quiet := FALSE); EVAL MergeUnits (ux, optional := FALSE); ETimer.Pop (); END; END BuildLibraryPool; PROCEDURE AddLibraryPool (units: M3Linker.UnitList) = BEGIN IF (build_base) THEN (* add all the units to the program right away *) EVAL MergeUnits (units, optional := FALSE); ELSE WHILE (units # NIL) DO AddLibraryUnit (units.unit); units := units.next; END; END; END AddLibraryPool; PROCEDURE AddLibraryUnit (u: M3Linker.Unit) = CONST suffix = ARRAY BOOLEAN OF TEXT {".m3", ".i3"}; VAR n: M3Linker.NameList; BEGIN Debug (" ", u.name.text, suffix[u.interface]); IF u.interface THEN AddLib (u.name.text, u); ELSE IF lib_impls.put (u.name.text, u) THEN FatalError ("duplicate module in libraries: ", u.name.text); END; n := u.exported_units; WHILE (n # NIL) DO AddLib (n.name.text, u); n := n.next; END; END; END AddLibraryUnit; PROCEDURE AddLib (name: TEXT; unit: M3Linker.Unit) = VAR ref: REFANY; ux := NEW (M3Linker.UnitList); old: M3Linker.UnitList; BEGIN ux.next := NIL; ux.unit := unit; IF lib_pool.in (name, ref) THEN old := ref; ux.next := old.next; old.next := ux; ELSE EVAL lib_pool.put (name, ux); END; END AddLib; (*-------------------------------------------------- fixed version stamps ---*) PROCEDURE FindFixedVersionStamps () = (* find the version stamps that won't change as a result of any compilations that we're about to perform *) VAR units: M3Linker.UnitList := NIL; BEGIN AddFixedVS (ic_sources, FileType.IC, units); AddFixedVS (is_sources, FileType.IS, units); AddFixedVS (io_sources, FileType.IO, units); AddFixedVS (mc_sources, FileType.MC, units); AddFixedVS (ms_sources, FileType.MS, units); AddFixedVS (mo_sources, FileType.MO, units); EVAL MergeUnits (units, optional := FALSE); END FindFixedVersionStamps; PROCEDURE AddFixedVS (list: ArgList; type: FileType; VAR ux: M3Linker.UnitList) = VAR a := list.head; BEGIN WHILE (a # NIL) DO AddFixedStamps (a.arg, type, ux); a := a.next; END; END AddFixedVS; PROCEDURE AddFixedStamps (file: TEXT; type: FileType; VAR ux: M3Linker.UnitList) = VAR units: M3Linker.UnitList; BEGIN Debug ("getting fixed link info for: ", file, "\n"); units := GetLinkUnits (file, type, imported := FALSE, optional := TRUE, quiet := FALSE); IF (units # NIL) THEN ux := AppendUnits (ux, units) END; END AddFixedStamps; (*------------------------------------------------------------ compilation --*) PROCEDURE CompileEverything () = BEGIN CompileO (io_sources); CompileO (mo_sources); CompileO (o_sources); CompileS (asm_sources, FileType.S); CompileS (is_sources, FileType.IS); CompileS (ms_sources, FileType.MS); CompileH (h_sources, FileType.H); CompileC (c_sources, FileType.C); CompileC (ic_sources, FileType.IC); CompileC (mc_sources, FileType.MC); CompileM3 (interfaces, FileType.I3); CompileM3 (modules, FileType.M3); StopServer (TRUE); END CompileEverything; PROCEDURE CompileO (list: ArgList) = VAR n := list.head; obj: TEXT; BEGIN IF (compile_to_C) OR (compile_to_S) THEN RETURN END; WHILE (n # NIL) DO obj := n.arg; IF bootstrap_mode THEN obj := TempCName (obj, FileType.O); IF NOT Text.Equal (n.arg, obj) AND ObjectIsStale (n.arg, obj) THEN Pull (n.arg, obj); END; END; AddObject (obj); n := n.next; END; END CompileO; PROCEDURE CompileS (list: ArgList; type: FileType) = VAR n := list.head; file, obj, tmp, tmp_obj: TEXT; BEGIN IF (compile_to_C) OR (compile_to_S) THEN RETURN END; WHILE (n # NIL) DO file := n.arg; IF NOT bootstrap_mode THEN obj := ObjectName (file, type); ELSE obj := TempCName (file, type); END; IF (obj # NIL) AND (NOT Text.Equal (obj, file)) THEN IF ObjectIsStale (file, obj) THEN IF bootstrap_mode THEN Pull (file, obj); ELSIF (type = FileType.S) THEN Pass1 (file, obj); ELSE (* FileType.IS or FileType.MS *) tmp := TempCName (file, type); EVAL tmp_files.put (tmp); tmp_obj := TempCObjName (tmp); EVAL tmp_files.put (tmp_obj); Clone (file, tmp); Pass1 (tmp, tmp_obj); Rename (tmp_obj, obj); Remove (tmp); END; END; END; AddObject (obj); n := n.next; END; END CompileS; PROCEDURE CompileC (list: ArgList; type: FileType) = VAR n := list.head; file, obj, tmp, tmp_obj: TEXT; BEGIN IF (compile_to_C) THEN RETURN END; WHILE (n # NIL) DO file := n.arg; IF bootstrap_mode THEN obj := TempCName (file, type); IF (obj # NIL) THEN IF (NOT Text.Equal (obj, file)) AND ObjectIsStale (file, obj) THEN Pull (file, obj); END; AddObject (TempCObjName (obj)); END; ELSE obj := ObjectName (file, type); IF (obj # NIL) AND (NOT Text.Equal (obj, file)) THEN IF ObjectIsStale (file, obj) THEN IF (type = FileType.C) THEN Pass1 (file, obj); ELSE (* FileType.IC or FileType.MC *) tmp := TempCName (file, type); EVAL tmp_files.put (tmp); tmp_obj := TempCObjName (tmp); EVAL tmp_files.put (tmp_obj); Clone (file, tmp); Pass1 (tmp, tmp_obj); Rename (tmp_obj, obj); Remove (tmp); END; END; AddObject (obj); END; END; n := n.next; END; END CompileC; PROCEDURE CompileH (list: ArgList; type: FileType) = VAR n := list.head; file, obj: TEXT; BEGIN IF NOT bootstrap_mode THEN RETURN END; WHILE (n # NIL) DO file := n.arg; obj := TempCName (file, type); IF NOT Text.Equal (obj, file) AND ObjectIsStale (file, obj) THEN Pull (file, obj); END; n := n.next; END; END CompileH; PROCEDURE CompileM3 (list: ArgList; type: FileType) = VAR n := list.head; BEGIN WHILE (n # NIL) DO CompileOneM3 (n.arg, type); n := n.next; END; END CompileM3; PROCEDURE CompileOneM3 (file: TEXT; type: FileType) = VAR obj, info, tmp, tmp_obj: TEXT; ok: BOOLEAN; units: M3Linker.UnitList; ref: REFANY; BEGIN IF (type = FileType.I3) THEN (* make sure we don't compile interfaces more than once *) IF NOT intf_map.delete (Filename.Tail (file), ref) THEN RETURN END; END; IF (bootstrap_mode) THEN obj := TempCName (file, type); ELSE obj := ObjectName (file, type); END; IF (obj # NIL) AND (NOT Text.Equal (obj, file)) THEN IF M3isStale (file, obj, type) THEN info := LinkInfoName (file, type); IF (compile_to_C) THEN ok := Pass0 (file, FinalCName (file, type), info); ELSIF (bootstrap_mode) THEN ok := Pass0 (file, obj, info); ELSE tmp := TempCName (file, type); EVAL tmp_files.put (tmp); tmp_obj := TempCObjName (tmp); EVAL tmp_files.put (tmp_obj); ok := Pass0 (file, tmp, info); IF (ok) THEN Pass1 (tmp, tmp_obj); Rename (tmp_obj, obj); END; IF (keep_files) THEN Rename (tmp, FinalCName (file, type)); ELSE Remove (tmp); END; END; IF (ok) THEN ETimer.Push (merge_timer); Debug ("reading final link info for ", file, "\n"); units := GetLinkUnits (file, type, imported := FALSE, optional := FALSE, quiet:= FALSE); CheckImports (units); Debug ("merging final link info for ", file, "\n"); EVAL MergeUnits (units, optional := FALSE); ETimer.Pop (); END; END; IF bootstrap_mode THEN obj := TempCObjName (obj); END; AddObject (obj); END; END CompileOneM3; PROCEDURE ObjectIsStale (source, obj: TEXT): BOOLEAN = VAR objTime: INTEGER; BEGIN IF (NOT make_mode) THEN Explain (" -> compiling ", source); RETURN TRUE END; ETimer.Push (staleobj_timer); (* check if the source is newer than the object *) objTime := OS.CreateTime (obj); (********************************************************* ---- too many people thought that "missing object" was an error, so we just won't distinguish a missing object from an old one. I guess "new source" is cheery, more positive message... ----- IF (objTime = OS.NO_TIME) THEN IF (bootstrap_mode) THEN Explain ("missing C -> compiling ", source); ELSE Explain ("missing object -> compiling ", source); END; ETimer.Pop (); RETURN TRUE; END; IF objTime < OS.CreateTime (source) THEN *********************************************************) IF (objTime = OS.NO_TIME) OR (objTime < OS.CreateTime (source)) THEN IF bootstrap_mode THEN Explain ("new source -> recreating ", source); ELSE Explain ("new source -> compiling ", source); END; ETimer.Pop (); RETURN TRUE; END; (* object exists and is newer than the source... *) ETimer.Pop (); RETURN FALSE; END ObjectIsStale; PROCEDURE M3isStale (source, obj: TEXT; type: FileType): BOOLEAN = VAR units: M3Linker.UnitList; BEGIN (* already done? *) IF checked.put (source) THEN RETURN FALSE END; IF ObjectIsStale (source, obj) THEN RETURN TRUE END; ETimer.Push (stalem3_timer); Debug ("getting initial link info for ", source, "\n"); units := GetLinkUnits (source, type, imported := FALSE, optional := TRUE, quiet := TRUE); IF (units = NIL) THEN Explain ("missing version stamps -> compiling ", source); ETimer.Pop (); RETURN TRUE; END; (* check my imports first *) CheckImports (units); (* check for new generics *) IF NewGenerics (units, obj) THEN Explain ("new generic source -> compiling ", source); RETURN TRUE; END; (* finally, add my self to the set *) Debug ("merging initial link info for ", source, "\n"); IF NOT MergeUnits (units, optional := TRUE) THEN Explain ("stale imports -> compiling ", source); ETimer.Pop (); RETURN TRUE; END; Debug (source, " is ok\n"); ETimer.Pop (); RETURN FALSE; END M3isStale; PROCEDURE CheckImports (ux: M3Linker.UnitList) = VAR u: M3Linker.Unit; n: M3Linker.NameList; ref: REFANY; BEGIN WHILE (ux # NIL) DO u := ux.unit; n := u.imported_units; WHILE (n # NIL) DO IF intf_map.in (n.name.text & ".i3", ref) THEN CompileOneM3 (ref, FileType.I3); END; n := n.next; END; ux := ux.next; END; END CheckImports; PROCEDURE NewGenerics (ux: M3Linker.UnitList; object: TEXT): BOOLEAN = VAR u: M3Linker.Unit; n: M3Linker.NameList; obj_time: INTEGER := OS.NO_TIME; generic_time: INTEGER; BEGIN WHILE (ux # NIL) DO u := ux.unit; n := u.imported_generics; WHILE (n # NIL) DO IF (obj_time = OS.NO_TIME) THEN obj_time := OS.CreateTime (object) END; generic_time := FindGeneric (n.name.text, u.interface); IF (obj_time < generic_time) THEN RETURN TRUE END; n := n.next; END; ux := ux.next; END; RETURN FALSE; END NewGenerics; PROCEDURE FindGeneric (name: TEXT; interface: BOOLEAN): INTEGER = CONST extension = ARRAY BOOLEAN OF TEXT { ".mg", ".ig" }; VAR tail := name & extension[interface]; full: TEXT; time: INTEGER; a := def_path.head; BEGIN WHILE (a # NIL) DO full := a.arg & "/" & tail; Debug ("generic probe: ", full, "\n"); time := OS.CreateTime (full); IF (time # OS.NO_TIME) THEN Verbose ("resolve: ", tail, " -> ", full); RETURN time; END; a := a.next; END; Verbose ("cannot find generic: ", tail); RETURN OS.NO_TIME; END FindGeneric; (*------------------------------------------------ compilations and links ---*) PROCEDURE Pass0 (source, object, info: TEXT): BOOLEAN = VAR args := NEW (ArgList); ok: BOOLEAN; size: INTEGER; BEGIN ETimer.Push (pass0_timer); IF (server_limit <= 0) THEN Append (args, pass_0); AppendL (args, pass_0_args); Append (args, warning_arg); Append (args, "-o" & object); Append (args, "-x" & info); Append (args, source); ok := (Execute (pass_0, args, fatal := FALSE) = 0) ELSE (* use a server *) IF (server = NIL) THEN StartServer () END; (* send the args & wait for the response *) Commands ("m3c ", source, " -o ", object & " -x " & info); TRY Wr.PutText (server.stdin, source); Wr.PutChar (server.stdin, '\n'); Wr.PutText (server.stdin, object); Wr.PutChar (server.stdin, '\n'); Wr.PutText (server.stdin, info); Wr.PutChar (server.stdin, '\n'); Wr.Flush (server.stdin); ok := (Rd.GetChar (server.stdout) = '0'); size := ToInt (Rd.GetLine (server.stdout)); EXCEPT Wr.Failure, Rd.Failure, Rd.EndOfFile, Thread.Alerted => Commands ("m3 server problem..."); ok := FALSE; size := server_limit + 1; END; IF (size > server_limit) THEN StopServer (TRUE) END; END; IF NOT ok THEN compile_failed := TRUE; IF (NOT keep_files) THEN Remove (object); Remove (info); END; END; ETimer.Pop (); RETURN ok; END Pass0; PROCEDURE StartServer () = VAR args := NEW (ArgList); argv: OS.ArgList; t := ""; BEGIN ETimer.Push (start_p0_timer); Append (args, pass_0); AppendL (args, pass_0_args); Append (args, warning_arg); Append (args, "-server"); argv := PrepArgs (pass_0, args); Wr.Flush (Stdio.stdout); Wr.Flush (Stdio.stderr); server := OS.Fork (pass_0, argv); IF (server.error # NIL) THEN FatalError ("unable to fork pass 0 as server: ", server.error); END; (* ping the server to make sure it started *) TRY Wr.PutText (server.stdin, "*\n"); Wr.Flush (server.stdin); t := Rd.GetLine (server.stdout); EXCEPT Wr.Failure, Rd.Failure, Rd.EndOfFile, Thread.Alerted => (* ouch *) END; IF NOT Text.Equal ("*", t) THEN FatalError ("pass 0 server didn't respond to ping"); END; ETimer.Pop (); END StartServer; PROCEDURE StopServer (wait: BOOLEAN) = BEGIN IF (server = NIL) THEN RETURN END; ETimer.Push (stop_p0_timer); Commands ("stop m3c: ", pass_0); TRY Wr.PutChar (server.stdin, '\n'); Wr.Flush (server.stdin); EXCEPT Wr.Failure, Thread.Alerted => wait := FALSE; END; OS.Stop (server, wait); server := NIL; ETimer.Pop (); END StopServer; PROCEDURE Pass1 (source, object: TEXT) = VAR args := NEW (ArgList); BEGIN ETimer.Push (pass1_timer); Append (args, pass_1); AppendL (args, pass_1_args); IF (compile_to_S) THEN Append (args, "-S"); ELSE Append (args, "-c"); END; Append (args, source); IF Execute (pass_1, args, fatal := FALSE) # 0 THEN compile_failed := TRUE; Remove (object); END; ETimer.Pop (); END Pass1; (*------------------------------------------------ compilations and links ---*) PROCEDURE BuildProgram () = CONST Main_C = "_m3main.c"; CONST Main_O = "_m3main.o"; VAR args := NEW (ArgList); pgmTime: INTEGER; pgmValid: BOOLEAN; a, b: ArgNode; dir, lib: TEXT; info_name: TEXT; pgm_obj := NEW (ArgList); wr: Wr.T; mode: M3Linker.CheckMode; magic: TEXT := NIL; BEGIN IF (compile_failed) THEN Explain ("compilation failed => not building program \"",pgm_name,"\""); RETURN; END; IF (base_pgm # NIL) THEN mode := M3Linker.Mode.Overlay; ELSIF (build_base) THEN mode := M3Linker.Mode.BaseProgram; ELSE mode := M3Linker.Mode.Program; END; pgmTime := OS.CreateTime (pgm_name); IF NOT make_mode THEN Explain (" -> linking ", pgm_name); pgmValid := FALSE; ELSIF (pgmTime = OS.NO_TIME) THEN Explain ("new objects -> linking ", pgm_name); pgmValid := FALSE; ELSE pgmValid := (latest_obj <= pgmTime); IF NOT pgmValid THEN Explain ("new objects -> linking ", pgm_name); END; END; a := objects.head; WHILE (a # NIL) DO IF pgmValid AND (OS.CreateTime (a.arg) > pgmTime) THEN Explain ("new \"",a.arg,"\" -> linking ",pgm_name); pgmValid := FALSE; END; Append (pgm_obj, LoaderName (a.arg)); a := a.next; END; IF (do_coverage) THEN Append (pgm_obj, link_coverage); END; a := libraries.head; b := lib_dirs.head; WHILE (a # NIL) DO IF pgmValid AND (OS.CreateTime (a.arg) > pgmTime) THEN Explain ("new \"",a.arg,"\" -> linking ",pgm_name); pgmValid := FALSE; END; IF (keep_resolved) THEN Append (pgm_obj, a.arg); ELSE IF UnresolveLib (a.arg, b.arg, dir, lib) THEN IF (dir # NIL) THEN Append (pgm_obj, "-L" & dir) END; Append (pgm_obj, "-l" & lib); ELSE Append (pgm_obj, a.arg); END; END; a := a.next; b := b.next; END; IF (msg_level >= MsgLevel.Debug) THEN Debug ("writing _link_info_\n"); wr := FileStream.OpenWrite ("_link_info_"); M3Linker.WriteUnits (link_base, NIL, wr); Wr.Close (wr); END; ETimer.Push (chkpgm_timer); IF NOT M3Linker.CheckSet (link_base, mode, Stdio.stderr) THEN FatalError ("incomplete program"); END; ETimer.Pop (); IF NOT pgmValid THEN IF (NOT keep_files) AND (NOT bootstrap_mode) THEN EVAL tmp_files.put (Main_C); EVAL tmp_files.put (Main_O); END; (* for a "base" program, write the link info *) IF (build_base) THEN magic := "_M3BASE_" & Fmt.Int (OS.Now (), 16); info_name := LinkInfoName (pgm_name, ClassifyName (pgm_name)); ETimer.Push (exhale_timer); Commands ("exhale ", info_name); wr := FileStream.OpenWrite (info_name); M3Linker.WriteUnits (link_base, magic, wr); Wr.Close (wr); ETimer.Pop (); END; (* build & compile the "main" program *) ETimer.Push (genMain_timer); Commands ("generate ", Main_C); wr := FileStream.OpenWrite (Main_C); M3Linker.GenerateMain (link_base, magic, wr, msg_level >=MsgLevel.Debug); Wr.Close (wr); ETimer.Pop (); IF NOT bootstrap_mode THEN Debug ("compiling ", Main_C, " ...\n"); Pass1 (Main_C, Main_O); IF (compile_failed) THEN FatalError ("cc ", Main_C, " failed!!") END; IF (build_base) THEN ETimer.Push (pass2_timer); (* build the base program *) Append (args, pass_2); AppendL (args, pass_2_args); AppendL (args, base_args); Append (args, "-o"); Append (args, pgm_name); Append (args, Main_O); AppendL (args, pgm_obj); EVAL Execute (pass_2, args, fatal := TRUE); (* and extract a standalone copy of its symbol table *) args := NEW (ArgList); Append (args, pass_5); AppendL (args, pass_5_args); Append (args, pgm_name); AppendL (args, overlay0_args); Append (args, "-x"); (* keep only the global symbols *) Append (args, "-o"); Append (args, pgm_name & "y" ); AppendL (args, overlay1_args); EVAL Execute (pass_5, args, fatal := TRUE); ETimer.Pop (); ELSIF (base_pgm = NIL) THEN ETimer.Push (pass2_timer); Append (args, pass_2); AppendL (args, pass_2_args); Append (args, "-o"); Append (args, pgm_name); Append (args, Main_O); AppendL (args, pgm_obj); EVAL Execute (pass_2, args, fatal := TRUE); ETimer.Pop (); ELSE (* build an overlay *) ETimer.Push (pass5_timer); Append (args, pass_5); AppendL (args, pass_5_args); Append (args, base_pgm & "y"); AppendL (args, overlay0_args); Append (args, "-o"); Append (args, pgm_name & ".ov" ); Append (args, Main_O); AppendL (args, pgm_obj); AppendL (args, overlay1_args); EVAL Execute (pass_5, args, fatal := TRUE); ETimer.Pop (); GenOverlayStartup (); END; IF (NOT keep_files) THEN Remove (Main_C); Remove (Main_O); END; END; END; (* always write the lists of objects for bootstrap *) IF bootstrap_mode THEN wr := FileStream.OpenWrite ("m3makefile.objs"); VAR sym_count := 0; last_group := 0; x := pgm_obj.head; BEGIN WHILE x # NIL DO IF sym_count MOD 60 = 0 THEN Wr.PutText (wr, "\nOBJS" & Fmt.Int (sym_count DIV 50) & " = "); last_group := sym_count DIV 50; END; IF sym_count MOD 4 = 0 THEN Wr.PutText (wr, "\\ @@\\\n "); END; Wr.PutText (wr, x.arg & " "); x := x.next; INC (sym_count); END; Wr.PutText (wr, " " & Main_O & "\nOBJS = "); FOR i := 0 TO last_group DO IF i MOD 5 = 0 THEN Wr.PutText (wr, "\\ @@\\\n "); END; Wr.PutText (wr, " $(OBJS" & Fmt.Int (i) & ")"); END; Wr.PutText (wr, "\n"); Wr.Close (wr); END; END; END BuildProgram; PROCEDURE GenOverlayStartup () = VAR wr := OS.NewExec (pgm_name); BEGIN Wr.PutText (wr, "#! /bin/sh\nexec "); Wr.PutText (wr, base_pgm); Wr.PutText (wr, " @M3overlay="); Wr.PutText (wr, pgm_name); Wr.PutText (wr, ".ov $*\n"); Wr.Close (wr); END GenOverlayStartup; PROCEDURE BuildLibrary () = CONST Main_C = "_m3lib.c"; CONST Main_O = "_m3lib.o"; VAR lib := lib_name; (*** lib := "lib" & lib_name & ".a"; ****) args := NEW (ArgList); a: ArgNode; wr: Wr.T; info: TEXT; lib_time: INTEGER; local_base: M3Linker.LinkSet; ux: M3Linker.UnitList; mode := M3Linker.Mode.Library; magic := "_M3LIB_" & Sanitize (lib_name); BEGIN IF (compile_failed) THEN Explain ("compilation failed => not building library \"",lib_name,"\""); RETURN; END; lib_time := OS.CreateTime (lib); IF NOT make_mode THEN Explain (" -> archiving ", lib); ELSIF (latest_obj <= lib_time) THEN RETURN; (* we're already done *) ELSIF (lib_time = OS.NO_TIME) THEN Explain ("new objects -> archiving ", lib); ELSE Explain ("new objects -> archiving ", lib); END; ETimer.Push (chkpgm_timer); IF NOT M3Linker.CheckSet (link_base, mode, Stdio.stderr) THEN FatalError ("incomplete library"); END; ETimer.Pop (); ETimer.Push (libmerge_timer); local_base := NIL; ux := local_units; WHILE (ux # NIL) DO local_base := M3Linker.MergeUnit (ux.unit, local_base, Stdio.stderr); IF (local_base = NIL) THEN FatalError ("inconsistent library") END; ux := ux.next; END; ETimer.Pop (); ETimer.Push (exhale_timer); info := LinkInfoName (lib, FileType.A); Commands ("exhale ", info); wr := FileStream.OpenWrite (info); M3Linker.WriteUnits (local_base, magic, wr); Wr.Close (wr); ETimer.Pop (); Debug ("building the library...\n"); Remove (lib); ETimer.Push (genLib_timer); Commands ("generate ", Main_C); wr := FileStream.OpenWrite (Main_C); M3Linker.GenerateMain (link_base, magic, wr, msg_level >=MsgLevel.Debug); Wr.Close (wr); ETimer.Pop (); IF NOT bootstrap_mode THEN Debug ("compiling ", Main_C, " ...\n"); Pass1 (Main_C, Main_O); IF (compile_failed) THEN FatalError ("cc ", Main_C, " failed!!") END; IF (msg_level >= MsgLevel.Debug) THEN (* add the verbose option to 'ar' *) WITH x = pass_3_args.tail DO IF (x # NIL) AND (Text.Equal (x.arg, "cru") OR Text.Equal (x.arg, "lcru")) THEN x.arg := x.arg & "v"; END; END; END; ETimer.Push (pass3_timer); Append (args, pass_3); AppendL (args, pass_3_args); Append (args, lib); Append (args, Main_O); a := objects.head; WHILE (a # NIL) DO Append (args, a.arg); a := a.next; END; EVAL Execute (pass_3, args, fatal := TRUE); ETimer.Pop (); ETimer.Push (pass4_timer); args := NEW (ArgList); Append (args, pass_4); AppendL (args, pass_4_args); Append (args, lib); EVAL Execute (pass_4, args, fatal := TRUE); ETimer.Pop (); IF (NOT keep_files) THEN Remove (Main_C); Remove (Main_O); END; END; END BuildLibrary; PROCEDURE Sanitize (path: TEXT): TEXT = (* turn path into a legal C identifier *) VAR name: TEXT; buf: ARRAY [0..31] OF CHAR; ch: CHAR; len: INTEGER; BEGIN name := Filename.Root (Filename.Tail (path)); len := MIN (Text.Length (name), NUMBER (buf)); Text.SetChars (buf, name); FOR i := 0 TO len - 1 DO ch := buf[i]; IF (('A' <= ch) AND (ch <= 'Z')) OR (('a' <= ch) AND (ch <= 'z')) OR (('0' <= ch) AND (ch <= '9')) THEN (* the character is ok *) ELSE buf[i] := '_'; END; END; RETURN Text.FromChars (SUBARRAY (buf, 0, len)); END Sanitize; (*------------------------------------------------------------ libraries ---*) PROCEDURE SplitLibrary () = CONST InfoSuffix = ARRAY BOOLEAN OF TEXT { ".mx", ".ix" }; VAR u: M3Linker.Unit; units: M3Linker.UnitList; sealed: M3Linker.LinkSet; name: TEXT; wr: Wr.T; BEGIN IF (ClassifyName (split_name) # FileType.A) THEN FatalError ("can only split a library"); END; ETimer.Push (inhale_timer); units := GetLinkUnits (split_name, FileType.A, imported := FALSE, optional := TRUE, quiet := FALSE); ETimer.Pop (); WHILE (units # NIL) DO ETimer.Push (exhale_timer); u := units.unit; name := u.name.text & InfoSuffix [u.interface]; Commands ("extract ", name); sealed := M3Linker.MergeUnit (u, NIL, Stdio.stderr); IF (sealed = NIL) THEN FatalError ("unable to split link info for ", name); END; wr := FileStream.OpenWrite (name); M3Linker.WriteUnits (sealed, NIL, wr); Wr.Close (wr); units := units.next; ETimer.Pop (); END; END SplitLibrary; PROCEDURE ResolveLib (name: TEXT; VAR dir: TEXT): TEXT = VAR tail := "lib" & name & ".a"; a := lib_path.head; full: TEXT; BEGIN dir := NIL; WHILE (a # NIL) DO full := a.arg & "/" & tail; IF (OS.CreateTime (full) # OS.NO_TIME) THEN Verbose ("resolve: ", name, " -> ", full); dir := a.arg; RETURN full; END; a := a.next; END; tail := "-l" & name; Verbose ("resolve: ", name, " -> ", tail); RETURN tail; END ResolveLib; PROCEDURE UnresolveLib (lib, ddir: TEXT; VAR(*OUT*) dir, name: TEXT): BOOLEAN= (* extract "PATH" and "XXX" from "PATH/libXXX.a" *) VAR tail := Filename.Tail (lib); BEGIN IF (ddir = NIL) THEN RETURN FALSE END; IF Text.Compare (Text.Sub (tail, 0, 3), "lib") # 0 THEN RETURN FALSE END; dir := ddir; name := Text.Sub (tail, 3, Text.Length (tail) - 5); RETURN TRUE; END UnresolveLib; (*--------------------------------------------------------- version stamps --*) PROCEDURE GetLinkUnits (file: TEXT; type: FileType; imported := FALSE; optional := TRUE; quiet := TRUE): M3Linker.UnitList = VAR rd: Rd.T; wr: Wr.T; info: TEXT; units: M3Linker.UnitList; start, stop: INTEGER; BEGIN IF (msg_level >= MsgLevel.Verbose) THEN start := OS.Now () END; (* try to open file's link info file *) info := LinkInfoName (file, type); TRY rd := FileStream.OpenRead (info); EXCEPT Rd.Failure => rd := NIL; END; IF (rd = NIL) THEN Debug ("unable to open link info file: ", info, "\n"); IF (NOT optional) THEN FatalError ("missing link info file: ", info) END; RETURN NIL; END; IF quiet AND (msg_level < MsgLevel.Verbose) THEN wr := NIL; ELSE wr := Stdio.stderr; END; (* try to read the file *) TRY units := M3Linker.ReadUnits (rd, file, imported, wr); FINALLY Rd.Close (rd); END; IF (units = NIL) THEN IF (NOT optional) THEN FatalError ("bad link info file: ", info); ELSE Debug ("bad link info file: ", info); END; RETURN NIL; END; IF (msg_level >= MsgLevel.Verbose) THEN stop := OS.Now (); Verbose ("reading \"", info, "\": ", Fmt.Int(stop-start), " seconds"); END; RETURN units; END GetLinkUnits; PROCEDURE MergeUnits (ux: M3Linker.UnitList; optional := TRUE): BOOLEAN = VAR new_base: M3Linker.LinkSet; start, stop: INTEGER; imports, xx: M3Linker.UnitList; BEGIN IF (msg_level >= MsgLevel.Verbose) THEN start := OS.Now () END; IF (ux = NIL) THEN RETURN TRUE END; (* add the library imports to the base link set *) imports := SearchLibrary (ux); IF (imports # NIL) THEN new_base := link_base; xx := imports; WHILE (xx # NIL) DO new_base := M3Linker.MergeUnit (xx.unit, new_base, Stdio.stderr); IF (new_base = NIL) THEN FatalError ("inconsistent library!") END; xx := xx.next; END; link_base := new_base; link_units := AppendUnits (link_units, imports); END; xx := ux; new_base := link_base; WHILE (xx # NIL) DO IF (optional) THEN new_base := M3Linker.MergeUnit (xx.unit, new_base, NIL); IF (new_base = NIL) THEN RETURN FALSE END; ELSE new_base := M3Linker.MergeUnit (xx.unit, new_base, Stdio.stderr); IF (new_base = NIL) THEN FatalError ("bad version stamps") END; END; xx := xx.next; END; local_units := AppendCopyOfUnits (local_units, ux); link_units := AppendUnits (link_units, ux); link_base := new_base; IF (msg_level >= MsgLevel.Verbose) THEN stop := OS.Now (); Verbose ("merging: ", Fmt.Int(stop-start), " seconds"); END; RETURN TRUE; END MergeUnits; (******** PROCEDURE DumpUnitList (tag: TEXT; ux: M3Linker.UnitList) = BEGIN Out (tag); WHILE (ux # NIL) DO Out (" ", ux.unit.name); ux := ux.next; END; Out ("\n"); END DumpUnitList; *********) PROCEDURE SearchLibrary (ux: M3Linker.UnitList): M3Linker.UnitList = VAR new, pending, tmp: M3Linker.UnitList; BEGIN Debug ("searching library: "); new := NIL; pending := NIL; (* add the "builtins" *) AddLibUnits (pending, builtin_name); (* add the direct imports *) WHILE (ux # NIL) DO AddLibUnits (pending, ux.unit.imported_units); AddLibUnits (pending, ux.unit.exported_units); ux := ux.next; END; (* then, add the indirect imports *) WHILE (pending # NIL) DO (* move a unit from pending to new *) tmp := pending; pending := pending.next; tmp.next := new; new := tmp; (* and add its imports *) AddLibUnits (pending, new.unit.imported_units); AddLibUnits (pending, new.unit.exported_units); END; Debug ("\n"); RETURN new; END SearchLibrary; PROCEDURE AddLibUnits (VAR pending: M3Linker.UnitList; n: M3Linker.NameList) = BEGIN WHILE (n # NIL) DO AddLibUnit (pending, n.name.text); n := n.next; END; END AddLibUnits; PROCEDURE AddLibUnit (VAR pending: M3Linker.UnitList; name: TEXT) = VAR ref: REFANY; lib, lib_next: M3Linker.UnitList; BEGIN IF lib_pool.delete (name, ref) THEN lib := ref; WHILE (lib # NIL) DO lib_next := lib.next; IF (lib.unit.interface) THEN (* add the interface to the pending list *) Debug (" ", lib.unit.name.text, ".i3"); lib.next := pending; pending := lib; ELSIF lib_impls.delete (lib.unit.name.text, ref) THEN (* here's a new impl => add it to the pending list *) Debug (" ", lib.unit.name.text, ".m3"); lib.next := pending; pending := lib; ELSE (* this impl has already been pulled from the lib *) END; lib := lib_next; END; END; END AddLibUnit; PROCEDURE AppendUnits (old, new: M3Linker.UnitList): M3Linker.UnitList = VAR last := new; BEGIN IF (last = NIL) THEN RETURN old END; WHILE (last.next # NIL) DO last := last.next END; last.next := old; RETURN new; END AppendUnits; PROCEDURE AppendCopyOfUnits (old, new: M3Linker.UnitList): M3Linker.UnitList = BEGIN WHILE (new # NIL) DO old := NEW (M3Linker.UnitList, next := old, unit := new.unit); new := new.next; END; RETURN old; END AppendCopyOfUnits; (*----------------------------------------------------------- file names ---*) PROCEDURE ClassifyName (name: TEXT): FileType = BEGIN FOR type := FIRST (FileType) TO LAST (FileType) DO IF SuffixMatch (name, FileSuffix[type]) THEN RETURN type END; END; RETURN FileType.Unknown; END ClassifyName; PROCEDURE SuffixMatch (base, suffix: TEXT): BOOLEAN = VAR base_len := Text.Length (base); VAR suff_len := Text.Length (suffix); VAR diff := base_len - suff_len; BEGIN IF (diff < 0) THEN RETURN FALSE END; FOR i := 0 TO suff_len-1 DO IF Text.GetChar (base, diff + i) # Text.GetChar (suffix, i) THEN RETURN FALSE; END; END; RETURN TRUE; END SuffixMatch; PROCEDURE TempCName (src: TEXT; type: FileType;): TEXT = TYPE F = FileType; VAR obj := Filename.Tail (src); BEGIN obj := Text.Sub (obj, 0, Text.Length (obj) - 3); CASE type OF | F.I3, F.IC => RETURN obj & "_i.c"; | F.IS => RETURN obj & "_i.s"; | F.M3, F.MC => RETURN obj & "_m.c"; | F.MS => RETURN obj & "_m.s"; | F.C => RETURN Filename.Tail (src); | F.H => RETURN Filename.Tail (src); | F.S => RETURN Filename.Tail (src); | F.O => RETURN Filename.Tail (src); ELSE <* ASSERT FALSE *> END; END TempCName; PROCEDURE FinalCName (src: TEXT; type: FileType;): TEXT = TYPE F = FileType; VAR obj := Filename.Tail (src); BEGIN obj := Text.Sub (obj, 0, Text.Length (obj) - 3); CASE type OF | F.I3, F.IC => RETURN obj & ".ic"; | F.IS => RETURN obj & ".is"; | F.M3, F.MC => RETURN obj & ".mc"; | F.MS => RETURN obj & ".ms"; ELSE <* ASSERT FALSE *> END; END FinalCName; PROCEDURE TempCObjName (src: TEXT): TEXT = VAR root := Text.Sub (src, 0, Text.Length (src) - 1); BEGIN IF (compile_to_S) THEN RETURN root & "s"; ELSE RETURN root & "o"; END; END TempCObjName; PROCEDURE ObjectName (src: TEXT; type: FileType;): TEXT = TYPE F = FileType; VAR obj := Filename.Tail (src); BEGIN CASE type OF | F.I3, F.IC, F.IS, F.M3, F.MC, F.MS, F.C, F.S => obj := Text.Sub (obj, 0, Text.Length (obj) - 1); IF (compile_to_C) THEN RETURN obj & "c"; ELSIF (compile_to_S) THEN RETURN obj & "s"; ELSE RETURN obj & "o"; END; ELSE RETURN NIL; END; END ObjectName; PROCEDURE LinkInfoName (src: TEXT; type: FileType): TEXT = TYPE F = FileType; VAR info := Filename.Tail (src); BEGIN CASE type OF | F.I3, F.M3 => RETURN Text.Sub (info, 0, Text.Length (info) - 1) & "x"; | F.IC, F.IS, F.IO, F.MC, F.MS, F.MO => RETURN Text.Sub (src, 0, Text.Length (src) - 1) & "x"; | F.A, F.B => RETURN src & "x"; ELSE RETURN NIL; END; END LinkInfoName; PROCEDURE LoaderName (file: TEXT): TEXT = VAR tmp: TEXT; len: INTEGER; BEGIN IF (NOT cc_paranoid) THEN RETURN file END; len := Text.Length (file); IF (len <= 3) THEN RETURN file END; tmp := Text.Sub (file, len-3, 3); IF Text.Equal (tmp, ".io") THEN tmp := Text.Sub (file, 0, len-3) & "_i.o"; OS.Clone (file, tmp); EVAL tmp_files.put (tmp); ELSIF Text.Equal (tmp, ".mo") THEN tmp := Text.Sub (file, 0, len-3) & "_m.o"; OS.Clone (file, tmp); EVAL tmp_files.put (tmp); ELSE tmp := file; END; RETURN tmp; END LoaderName; (*----------------------------------------------------------- arg lists ---*) PROCEDURE Append (list: ArgList; val: TEXT) = VAR n := NEW (ArgNode, next := NIL, arg := val); BEGIN IF (list.head = NIL) THEN list.head := n; ELSE list.tail.next := n; END; list.tail := n; INC (list.cnt); END Append; PROCEDURE Prepend (list: ArgList; val: TEXT) = VAR n := NEW (ArgNode, next := list.head, arg := val); BEGIN IF (list.tail = NIL) THEN list.tail := n END; list.head := n; INC (list.cnt); END Prepend; PROCEDURE AppendL (a, b: ArgList) = VAR n := b.head; BEGIN WHILE (n # NIL) DO Append (a, n.arg); n := n.next; END; END AppendL; PROCEDURE PopArg (list: ArgList): TEXT = VAR txt: TEXT; BEGIN IF (list = NIL) OR (list.cnt <= 0) THEN RETURN NIL END; txt := list.head.arg; list.head := list.head.next; DEC (list.cnt); RETURN txt; END PopArg; (*------------------------------------------------------------------ misc ---*) PROCEDURE PrepArgs (program: TEXT; args: ArgList): OS.ArgList = VAR argv := NEW (REF ARRAY OF TEXT, args.cnt); a := args.head; BEGIN (* build the argument vector *) FOR i := 0 TO args.cnt-1 DO argv[i] := a.arg; a := a.next END; IF (argv[0] = NIL) THEN argv[0] := program END; (* provide the listing *) IF (msg_level >= MsgLevel.Commands) THEN Out (program); VAR n := args.head.next; BEGIN WHILE (n # NIL) DO Out (" ", n.arg); n := n.next END; END; Out ("\n"); END; RETURN argv; END PrepArgs; PROCEDURE Execute (program: TEXT; args: ArgList; fatal: BOOLEAN): INTEGER = VAR argv := PrepArgs (program, args); result: OS.RunResult; BEGIN Wr.Flush (Stdio.stdout); Wr.Flush (Stdio.stderr); result := OS.Run (program, argv); IF (result.signal # 0) THEN FatalError ("program \""& program &"\" got fatal signal ", Fmt.Int (result.signal)); END; IF (fatal) AND (result.status # 0) THEN FatalError ("program \""& program &"\" failed (exit status ", Fmt.Int (result.status), ")"); END; RETURN result.status; END Execute; PROCEDURE Pull (src, dest: TEXT) = BEGIN Remove (dest); Copy (src, dest); END Pull; PROCEDURE Remove (file: TEXT) = BEGIN ETimer.Push (remove_timer); Commands ("rm ", file); OS.Remove (file); EVAL tmp_files.delete (file); ETimer.Pop (); END Remove; PROCEDURE Rename (old, new: TEXT) = BEGIN ETimer.Push (rename_timer); Commands ("mv ", old, " ", new); OS.Rename (old, new); EVAL tmp_files.delete (old); ETimer.Pop (); END Rename; PROCEDURE Clone (old, new: TEXT) = BEGIN ETimer.Push (clone_timer); Commands ("link ", old, " ", new); OS.Clone (old, new); ETimer.Pop (); END Clone; PROCEDURE Copy (old, new: TEXT) = VAR args := NEW (ArgList); BEGIN ETimer.Push (copy_timer); Append (args, "cp"); Append (args, old); Append (args, new); EVAL Execute ("cp", args, fatal := TRUE); ETimer.Pop (); END Copy; PROCEDURE FatalError (a, b, c, d: TEXT := NIL) = BEGIN CleanUp (); StopTimers (); (** Out ("\nFatal Error: ", a, b, c, d, "\n"); **) Wr.Flush (Stdio.stdout); ZOut (Stdio.stderr, "\nFatal Error: ", a, b, c, d, "\n\n"); OS.Exit (-1); END FatalError; PROCEDURE Debug (a, b, c, d: TEXT := NIL) = BEGIN IF (msg_level >= MsgLevel.Debug) THEN Out (a, b, c, d) END; END Debug; PROCEDURE Verbose (a, b, c, d, e: TEXT := NIL) = BEGIN IF (msg_level >= MsgLevel.Verbose) THEN Out (a, b, c, d, e, "\n") END; END Verbose; PROCEDURE Commands (a, b, c, d: TEXT := NIL) = VAR in := ""; BEGIN IF (msg_level >= MsgLevel.Commands) THEN Out (in, a, b, c, d, "\n") END; END Commands; PROCEDURE Explain (a, b, c, d: TEXT := NIL) = BEGIN IF (msg_level >= MsgLevel.Explain) THEN IF (msg_level > MsgLevel.Explain) THEN Out ("\n") END; Out (a, b, c, d, "\n"); END; END Explain; PROCEDURE OutL (a, b: TEXT; l: ArgList) = VAR gap: TEXT := NIL; BEGIN Out (a, b); IF (l # NIL) THEN IF (b # NIL) THEN gap := " " END; VAR n := l.head; BEGIN WHILE (n # NIL) DO Out (gap, n.arg); gap := " "; n := n.next END; END; END; Out ("\n"); END OutL; PROCEDURE Out (a, b, c, d, e, f: TEXT := NIL) = BEGIN ZOut (Stdio.stdout, a, b, c, d, e, f); END Out; PROCEDURE ZOut (wr: Wr.T; a, b, c, d, e, f: 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; IF (e # NIL) THEN Wr.PutText (wr, e) END; IF (f # NIL) THEN Wr.PutText (wr, f) END; Wr.Flush (wr); END ZOut; BEGIN DoIt (); END Main.