Copyright (C) 1994, Digital Equipment Corp.
File: M3Compiler.m3
MODULE M3Compiler;
IMPORT Wr, Fmt, Thread(** , RTCollector, RTCollectorSRC **);
IMPORT Token, Error, Scanner, Value, Scope, M3String, RefType;
IMPORT Module, Type, BuiltinTypes, Host, Tracer, M3Header;
IMPORT BuiltinOps, WordModule, M3, Time, Coverage, Marker, TypeFP;
IMPORT Ident, TextExpr, Procedure, SetExpr, TipeDesc, Pathname;
IMPORT ESet, CG, TextWr, Target, ProcBody, Runtime, M3ID;
VAR mu : MUTEX := NEW (MUTEX);
VAR builtins : Module.T := NIL;
PROCEDURE ParseImports (READONLY input : SourceFile;
env : Environment): IDList =
VAR ids: IDList := NIL;
BEGIN
LOCK mu DO
(* make the arguments globally visible *)
Host.env := env;
Host.source := input.contents;
Host.filename := input.name;
Scanner.Push (Host.filename, Host.source, is_main := TRUE);
ids := M3Header.Parse ();
Scanner.Pop ();
RETURN ids;
END;
END ParseImports;
PROCEDURE Compile (READONLY input : SourceFile;
env : Environment;
READONLY options : ARRAY OF TEXT): BOOLEAN =
VAR ok: BOOLEAN; start: Time.T;
BEGIN
LOCK mu DO
start := Time.Now ();
(* make the arguments globally visible *)
Host.env := env;
Host.source := input.contents;
Host.filename := input.name;
IF NOT Host.Initialize (options) THEN RETURN FALSE; END;
IF NOT Host.stack_walker THEN
(* command line override... *)
Target.Has_stack_walker := FALSE;
END;
IF (builtins = NIL) THEN Initialize () END;
Reset ();
DoCompile ();
ok := Finalize ();
IF (Host.report_stats) THEN DumpStats (start, Time.Now ()); END;
END;
RETURN ok;
END Compile;
PROCEDURE Initialize () =
BEGIN
(* this list is ordered! *)
Type.Initialize ();
TypeFP.Initialize ();
Scanner.Push ("M3_BUILTIN", NIL, is_main := Host.emitBuiltins);
builtins := Module.NewDefn ("M3_BUILTIN", TRUE, Scope.Initial);
BuiltinTypes.Initialize ();
BuiltinOps.Initialize ();
Scanner.Pop ();
Scanner.Push ("Word.i3", NIL, is_main := Host.emitBuiltins);
WordModule.Initialize ();
Scanner.Pop ();
END Initialize;
PROCEDURE Reset () =
BEGIN
(* this list is ordered! *)
M3String.Reset ();
Scanner.Reset ();
Scope.Reset ();
Coverage.Reset ();
Error.Reset ();
Marker.Reset ();
ESet.Reset ();
ProcBody.Reset ();
Runtime.Reset ();
TipeDesc.Reset ();
Tracer.Reset ();
Type.Reset ();
TypeFP.Reset ();
RefType.Reset ();
Value.Reset ();
Module.Reset ();
Ident.Reset ();
TextExpr.Reset ();
Procedure.Reset ();
SetExpr.Init ();
END Reset;
PROCEDURE DoCompile () =
VAR m: Module.T; cs := M3.OuterCheckState; m_name, filename: M3ID.T;
BEGIN
**
RTCollectorSRC.gcRatio := 0.5; (* don't bother collecting much
RTCollectorSRC.incremental := FALSE;
RTCollector.Disable ();
***)
Scanner.Push (Host.filename, Host.source, is_main := TRUE);
StartPhase ("initializing builtins");
CheckBuiltins ();
StartPhase ("parsing");
m := Module.Parse ();
(* check that the module name matches the file name *)
m_name := Module.Name (m);
filename := M3ID.Add (Pathname.LastBase (Host.filename));
IF (m_name # filename) THEN
Error.Warn (2, "file name (" & Pathname.Last (Host.filename)
& ") doesn't match module name ("
& M3ID.ToText (m_name) & ")");
END;
**
RTCollector.Enable ();
**
IF Failed () THEN RETURN END;
StartPhase ("type checking");
Module.TypeCheck (m, TRUE, cs);
IF Failed () THEN RETURN END;
StartPhase ("emitting code");
CG.Init ();
IF Failed () THEN RETURN END;
IF (Host.emitBuiltins) THEN
Module.MakeCurrent (builtins);
Module.MakeCurrent (WordModule.M);
Module.Compile (builtins);
Module.Compile (WordModule.M);
ELSE
Module.Compile (m);
END;
IF Failed () THEN RETURN END;
END DoCompile;
PROCEDURE CheckBuiltins () =
VAR cs := M3.OuterCheckState;
BEGIN
Value.TypeCheck (builtins, cs);
Value.TypeCheck (WordModule.M, cs);
END CheckBuiltins;
PROCEDURE StartPhase (tag: TEXT) =
BEGIN
IF (Host.verbose) THEN
Host.env.report_error (NIL, 0, tag & "...");
END;
END StartPhase;
PROCEDURE Failed (): BOOLEAN =
VAR errs, warns: INTEGER;
BEGIN
Error.Count (errs, warns);
RETURN (errs > 0);
END Failed;
PROCEDURE DumpStats (start, stop: Time.T) =
<*FATAL Wr.Failure, Thread.Alerted*>
VAR
wr := TextWr.New ();
elapsed := MAX (stop - start, 1.0d-6);
speed := FLOAT (Scanner.nLines, LONGREAL) / elapsed;
BEGIN
Wr.PutText (wr, " ");
Wr.PutText (wr, Fmt.Int (Scanner.nLines));
Wr.PutText (wr, " lines (");
Wr.PutText (wr, Fmt.Int (Scanner.nPushed));
Wr.PutText (wr, " files) scanned, ");
Wr.PutText (wr, Fmt.LongReal (elapsed, Fmt.Style.Fix, 2));
Wr.PutText (wr, " seconds, ");
Wr.PutText (wr, Fmt.LongReal (speed, Fmt.Style.Fix, 1));
Wr.PutText (wr, " lines / second.");
Host.env.report_error (NIL, 0, TextWr.ToText (wr));
END DumpStats;
PROCEDURE Finalize (): BOOLEAN =
<*FATAL Wr.Failure, Thread.Alerted*>
VAR errs, warns: INTEGER; wr: TextWr.T;
BEGIN
Scanner.Pop ();
Error.Count (errs, warns);
IF (errs + warns > 0) THEN
wr := TextWr.New ();
IF (errs > 0) THEN
Wr.PutText (wr, Fmt.Int (errs));
Wr.PutText (wr, " error");
IF (errs > 1) THEN Wr.PutText (wr, "s") END;
END;
IF (warns > 0) THEN
IF (errs > 0) THEN Wr.PutText (wr, " and ") END;
Wr.PutText (wr, Fmt.Int (warns));
Wr.PutText (wr, " warning");
IF (warns > 1) THEN Wr.PutText (wr, "s") END;
END;
Wr.PutText (wr, " encountered");
Host.env.report_error (NIL, 0, TextWr.ToText (wr));
END;
RETURN (errs <= 0);
END Finalize;
BEGIN
M3String.Initialize ();
Token.Initialize ();
Scanner.Initialize ();
Scope.Initialize ();
END M3Compiler.