*************************************************************************
Copyright (C) Olivetti 1989
All Rights reserved
Use and copy of this software and preparation of derivative works based
upon this software are permitted to any person, provided this same
copyright notice and the following Olivetti warranty disclaimer are
included in any copy of the software or any modification thereof or
derivative work therefrom made by any person.
This software is made available AS IS and Olivetti disclaims all
warranties with respect to this software, whether expressed or implied
under any law, including all implied warranties of merchantibility and
fitness for any purpose. In no event shall Olivetti be liable for any
damages whatsoever resulting from loss of use, data or profits or
otherwise arising out of or in connection with the use or performance
of this software.
*************************************************************************
Copyright (C) 1994, Digital Equipment Corp.
MODULE M3CGo;
IMPORT Text, Rd, RefList;
IMPORT M3AST_AS, M3Time;
IMPORT M3CSrcPos, M3CLiteral;
IMPORT M3AST_LX_F, M3AST_AS_F, M3AST_SM_F, M3AST_FE_F;
IMPORT SeqM3AST_AS_Used_interface_id, SeqM3AST_AS_IMPORTED,
SeqM3AST_AS_Import_item;
IMPORT M3CId, M3Context, M3Error, M3CParse, M3CUnit, M3CUnitRep,
M3Conventions;
IMPORT M3CMkStd, M3CSM, M3CSpec, M3CGenIns;
VAR
current_g: M3AST_AS.Compilation_Unit;
parser_g: M3CParse.T := NIL;
PROCEDURE CompileInterface(
context: M3Context.T;
used_id: M3AST_AS.Used_interface_id;
caller: M3AST_AS.Compilation_Unit;
isexport: BOOLEAN;
p: ImportedUnitProc)
RAISES {}=
VAR
interface: M3AST_AS.Compilation_Unit;
ens: Text.T;
BEGIN
IF used_id.lx_symrep # NIL AND
p(M3CId.ToText(used_id.lx_symrep),
M3CUnit.Type.Interface, context, interface) THEN
used_id.sm_def := interface.as_root.as_id;
IF ISTYPE(interface.as_root, M3AST_AS.UNIT_GEN_DEF) THEN
M3Error.ReportWithId(used_id,
"illegal import of GENERIC interface \'%s\'", used_id.lx_symrep);
ELSIF NOT (M3CUnit.State.ImportsResolved IN interface.fe_status) AND
(caller # interface) THEN
(* cycle in imports! This can never happen if the 'lx_symrep' of either
is NIL *)
M3Error.ReportWithId(used_id,
"import cycle between interfaces \'%s\' and \'%s\'",
used_id.lx_symrep, caller.as_root.as_id.lx_symrep);
M3CUnit.InclState(interface.fe_status, M3CUnit.State.IErrors);
M3CUnit.InclState(caller.fe_status, M3CUnit.State.IErrors);
ELSE
(* if there were IErrors in interface, propagate this fact *)
IF M3CUnit.State.IErrors IN interface.fe_status THEN
M3CUnit.InclState(caller.fe_status, M3CUnit.State.IErrors);
END;
IF Safe(caller) THEN
IF NOT Safe(interface) THEN
IF isexport THEN
ens := "illegal export of unsafe interface \'%s\'"
ELSE
ens := "illegal import of unsafe interface \'%s\'"
END;
M3Error.ReportWithId(used_id, ens, used_id.lx_symrep);
END; (* if *)
END; (* if *)
RETURN (* OK *)
END; (* if *)
END;
M3CUnit.InclState(current_g.fe_status, M3CUnit.State.IErrors);
END CompileInterface;
<*INLINE*> PROCEDURE Safe(cu: M3AST_AS.Compilation_Unit): BOOLEAN RAISES {}=
BEGIN
RETURN NARROW(cu.as_root, M3AST_AS.UNIT_NORMAL).as_unsafe = NIL;
END Safe;
PROCEDURE CompileImports(
context: M3Context.T;
cu: M3AST_AS.Compilation_Unit;
p: ImportedUnitProc)
RAISES {}=
VAR
iterImported: SeqM3AST_AS_IMPORTED.Iter;
imported: M3AST_AS.IMPORTED;
iterImport_item: SeqM3AST_AS_Import_item.Iter;
import_item: M3AST_AS.Import_item;
local_from_name: M3AST_AS.Import_item;
from_name: M3AST_AS.Used_interface_id;
unit_normal := NARROW(cu.as_root, M3AST_AS.UNIT_NORMAL);
BEGIN
iterImported := SeqM3AST_AS_IMPORTED.NewIter(unit_normal.as_import_s);
WHILE SeqM3AST_AS_IMPORTED.Next(iterImported, imported) DO
TYPECASE imported OF <*NOWARN*>
| M3AST_AS.Simple_import(si) =>
iterImport_item := SeqM3AST_AS_Import_item.NewIter(si.as_import_item_s);
WHILE SeqM3AST_AS_Import_item.Next(
iterImport_item, import_item) DO
CompileInterface(context, import_item.as_intf_id, cu, FALSE, p);
END; (* while *)
| M3AST_AS.From_import(fi) =>
local_from_name := CheckForLocalName(unit_normal, fi.as_intf_id);
IF local_from_name = NIL THEN from_name := fi.as_intf_id
ELSE from_name := local_from_name.as_intf_id;
END;
CompileInterface(context, from_name, cu, FALSE, p);
(* fix things up; CompileInterface will have set from_name.sm_def
to the Interface_id of the imported AST. However, if
local_from_name # NIL, we need to bind to its Interface_AS_id.
*)
IF local_from_name # NIL THEN
fi.as_intf_id.sm_def := local_from_name.as_id;
END; (* if *)
END; (* typecase *)
END;
END CompileImports;
PROCEDURE CheckForLocalName(
unit_normal: M3AST_AS.UNIT_NORMAL;
intf_id: M3AST_AS.Used_interface_id)
: M3AST_AS.Import_item
RAISES {}=
VAR
iterImported: SeqM3AST_AS_IMPORTED.Iter;
imported: M3AST_AS.IMPORTED;
iterImport_item: SeqM3AST_AS_Import_item.Iter;
import_item: M3AST_AS.Import_item;
BEGIN
iterImported := SeqM3AST_AS_IMPORTED.NewIter(unit_normal.as_import_s);
WHILE SeqM3AST_AS_IMPORTED.Next(iterImported, imported) DO
TYPECASE imported OF
| M3AST_AS.Simple_import(si) =>
iterImport_item := SeqM3AST_AS_Import_item.NewIter(si.as_import_item_s);
WHILE SeqM3AST_AS_Import_item.Next(
iterImport_item, import_item) DO
IF import_item.as_id # NIL AND
import_item.as_id.lx_symrep = intf_id.lx_symrep THEN
RETURN import_item;
END;
END; (* while *)
ELSE (* ignore From_import *)
END; (* typecase *)
END;
RETURN NIL;
END CheckForLocalName;
PROCEDURE CompileExports(
context: M3Context.T;
cu: M3AST_AS.Compilation_Unit;
p: ImportedUnitProc)
RAISES {}=
VAR
moduleId: M3AST_AS.Module_id;
exports: SeqM3AST_AS_Used_interface_id.T;
iterExports: SeqM3AST_AS_Used_interface_id.Iter;
export: M3AST_AS.Used_interface_id;
BEGIN
TYPECASE cu.as_root OF
| M3AST_AS.Module(module) =>
moduleId := module.as_id;
exports := module.as_export_s;
IF SeqM3AST_AS_Used_interface_id.Empty(exports) THEN
(* implicit export of interface with same name as module *)
export := NEW(M3AST_AS.Used_interface_id).init();
export.lx_symrep := moduleId.lx_symrep;
export.lx_srcpos := moduleId.lx_srcpos;
SeqM3AST_AS_Used_interface_id.AddRear(module.sm_export_s, export);
CompileInterface(context, export, cu, TRUE, p);
ELSE
iterExports := SeqM3AST_AS_Used_interface_id.NewIter(exports);
WHILE SeqM3AST_AS_Used_interface_id.Next(iterExports, export) DO
SeqM3AST_AS_Used_interface_id.AddRear(module.sm_export_s, export);
CompileInterface(context, export, cu, TRUE, p);
END; (* while *)
END; (* if *)
ELSE
(* interface - does not have any exports *)
END; (* typecase *)
END CompileExports;
PROCEDURE ResolveImportsAndExports(
context: M3Context.T;
cu: M3AST_AS.Compilation_Unit;
p: ImportedUnitProc)
RAISES {}=
BEGIN
IF NOT (M3CUnit.State.ImportsResolved IN cu.fe_status) THEN
CompileExports(context, cu, p);
CompileImports(context, cu, p);
M3CUnit.InclState(cu.fe_status, M3CUnit.State.ImportsResolved);
END; (* if *)
END ResolveImportsAndExports;
PROCEDURE ErrorHandler(
<*UNUSED*> h: M3CParse.ErrorHandler;
pos: M3CSrcPos.T;
msg: TEXT)
RAISES {}=
BEGIN
M3CUnit.InclState(current_g.fe_status, M3CUnit.State.PErrors);
M3Error.ReportAtPos(pos, msg);
END ErrorHandler;
PROCEDURE Parse(
input: Rd.T;
cu: M3AST_AS.Compilation_Unit;
headerOnly: BOOLEAN;
) RAISES {Rd.Failure}=
VAR
tcu: M3AST_AS.Compilation_Unit;
BEGIN
tcu := NewParser(input).compilation(headerOnly);
cu.as_root := tcu.as_root;
cu.lx_pragmas := tcu.lx_pragmas;
cu.lx_comments := tcu.lx_comments;
(* Unless we have no tree at all, mark as parsed *)
IF cu.as_root # NIL THEN
M3CUnit.InclState(cu.fe_status, M3CUnit.State.Parsed);
END; (* if *)
END Parse;
<*INLINE*> PROCEDURE NewParser(input: Rd.T): M3CParse.T RAISES {}=
VAR
errorHandler: M3CParse.ErrorHandler;
BEGIN
(* reuse global parser *)
IF parser_g = NIL THEN
errorHandler := NEW(M3CParse.ErrorHandler, handle := ErrorHandler);
parser_g := NEW(M3CParse.T).init(input, M3CId.Table(),
M3CLiteral.Table(), errorHandler);
ELSE
parser_g.reset(rd := input);
END; (* if *)
RETURN parser_g;
END NewParser;
PROCEDURE CompileUnit(
cu: M3AST_AS.Compilation_Unit;
context: M3Context.T;
stream: Rd.T;
p: ImportedUnitProc;
VAR (*inout*) phases: M3CUnit.Status;
compTime: M3Conventions.CompTime;
headerOnly := FALSE
) RAISES {}=
<*FATAL Rd.Failure*>
VAR
saveCu: M3AST_AS.Compilation_Unit := current_g;
startTime: M3Time.T;
checkedSem := FALSE;
BEGIN
current_g := cu;
TRY
(* PARSING *)
IF M3CUnit.State.Parsed IN phases THEN
IF compTime # NIL THEN startTime := M3Time.Now(); END;
Parse(stream, cu, headerOnly);
IF compTime # NIL THEN compTime.parse := M3Time.Interval(startTime) END;
phases := phases + (cu.fe_status * M3CUnit.Errors);
END;
(* GENERICS *)
IF ISTYPE(cu.as_root, M3AST_AS.UNIT_GEN_DEF) THEN
(* nothing more to do for generic definitions *)
M3CSpec.Set(cu);
RETURN
ELSIF ISTYPE(cu.as_root, M3AST_AS.UNIT_GEN_INS) THEN
(* ok, do the instantiation, and compile it *)
VAR cu_res := CompileGenericInstantiation(context, cu, p);
BEGIN
IF cu_res = NIL THEN
RETURN
ELSE
(* continue with instantiated unit *)
cu := cu_res;
current_g := cu;
M3Error.SetCu(cu);
END; (* if *)
END;
END; (* if *)
(* IMPORT RESOLUTION *)
IF M3CUnit.State.ImportsResolved IN phases THEN
(* precondition *)
IF M3CUnit.State.Parsed IN cu.fe_status THEN
IF cu = M3Context.Standard() THEN M3CMkStd.TransForm(cu); END;
ResolveImportsAndExports(context, cu, p);
IF M3CUnit.State.IErrors IN cu.fe_status THEN
M3CUnit.InclState(phases, M3CUnit.State.IErrors);
END; (* if *)
ELSE
M3CUnit.InclState(phases, M3CUnit.State.IErrors);
END;
END;
(* SEMANTIC ANALYSIS *)
IF M3CUnit.State.SemChecked IN phases THEN
(* precondition *)
IF M3CUnit.State.ImportsResolved IN cu.fe_status THEN
(* IMPORT errors make checking semantics worthless/dangerous *)
IF M3CUnit.State.IErrors IN cu.fe_status THEN
M3Error.Report(cu.as_root,
"semantic analysis suppressed due to import errors");
ELSE
IF compTime # NIL THEN startTime := M3Time.Now(); END;
M3CSM.Check(cu);
checkedSem := TRUE;
M3CUnit.InclState(cu.fe_status, M3CUnit.State.SemChecked);
IF compTime # NIL THEN
compTime.semantic := M3Time.Interval(startTime)
END;
END; (* if *)
ELSE
M3CUnit.InclState(phases, M3CUnit.State.SErrors);
END; (* if *)
END;
FINALLY
LOCK extensions_m DO
VAR list: RefList.T := extensions_g;
BEGIN
WHILE list # NIL DO
NARROW(list.head, ExtensionElem).e.extend(context, cu, phases);
list := list.tail;
END;
END;
END;
IF checkedSem THEN
M3CSM.FinishUp(cu);
END;
current_g := saveCu;
END;
END CompileUnit;
PROCEDURE CompileGenericInstantiation(
context: M3Context.T;
cu_ins: M3AST_AS.Compilation_Unit;
p: ImportedUnitProc): M3AST_AS.Compilation_Unit
RAISES {}=
VAR
unit_ins := NARROW(cu_ins.as_root, M3AST_AS.UNIT_GEN_INS);
gen_id := unit_ins.as_gen_id;
cu_def: M3AST_AS.Compilation_Unit;
ut: M3CUnit.Type;
BEGIN
IF ISTYPE(unit_ins, M3AST_AS.Interface_gen_ins) THEN
ut := M3CUnit.Type.Interface;
ELSE
ut := M3CUnit.Type.Module;
END; (* if *)
IF gen_id.lx_symrep # NIL AND
p(M3CId.ToText(gen_id.lx_symrep), ut, context, cu_def) THEN
IF ut = M3CUnit.Type.Interface AND
NOT ISTYPE(cu_def.as_root, M3AST_AS.Interface_gen_def) THEN
M3Error.ReportWithId(gen_id,
"\'%s\' is not an GENERIC interface", gen_id.lx_symrep);
ELSIF ut = M3CUnit.Type.Module AND
NOT ISTYPE(cu_def.as_root, M3AST_AS.Module_gen_def) THEN
M3Error.ReportWithId(gen_id,
"\'%s\' is not an GENERIC module", gen_id.lx_symrep);
ELSE
gen_id.sm_def := cu_def.as_root.as_id;
unit_ins.sm_ins_comp_unit := M3CGenIns.Set(cu_ins, cu_def);
WITH cu_res = unit_ins.sm_ins_comp_unit DO
IF cu_res # NIL THEN
cu_res.fe_uid := NEW(M3CUnit.Uid);
cu_res.fe_uid.filename := cu_def.fe_uid.filename &
"[" & cu_ins.fe_uid.filename & "]";
cu_res.fe_uid.stamp := cu_ins.fe_uid.stamp;
IF M3Conventions.PrimarySource IN cu_ins.fe_status THEN
M3CUnit.InclState(cu_res.fe_status, M3Conventions.PrimarySource);
END; (* if *)
END;
END; (* with *)
RETURN unit_ins.sm_ins_comp_unit;
END; (* if *)
END; (* if *)
M3CUnit.InclState(cu_ins.fe_status, M3CUnit.State.IErrors);
RETURN NIL;
END CompileGenericInstantiation;
PROCEDURE Current(): M3AST_AS.Compilation_Unit RAISES {}=
BEGIN
RETURN current_g;
END Current;
REVEAL
Extension = Extension_public BRANDED OBJECT END;
TYPE ExtensionElem = REF RECORD e: Extension END;
VAR
extensions_g: RefList.T := NIL;
extensions_m := NEW(MUTEX);
PROCEDURE AddExtension(e: Extension) RAISES {}=
BEGIN
LOCK extensions_m DO
extensions_g := RefList.AppendD(extensions_g,
RefList.List1(NEW(ExtensionElem, e := e)));
END; (* lock *)
END AddExtension;
PROCEDURE RemoveExtension(e: Extension) RAISES {}=
VAR l, prev: RefList.T := extensions_g;
BEGIN
LOCK extensions_m DO
WHILE l # NIL DO
IF NARROW(l.head, ExtensionElem).e = e THEN
IF prev = NIL THEN extensions_g := l.tail
ELSE prev.tail := l.tail;
END;
RETURN
END;
prev := l; l := l.tail;
END;
END; (* lock *)
END RemoveExtension;
BEGIN
current_g := NIL;
END M3CGo.