Copyright (C) 1991, Digital Equipment Corporation All rights reserved. See the file COPYRIGHT for a full description.
MODULE; 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 M3CGo 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*> PROCEDURESafe (cu: M3AST_AS.Compilation_Unit): BOOLEAN RAISES {}= BEGIN RETURN NARROW(cu.as_root, M3AST_AS.UNIT_NORMAL).as_unsafe = NIL; END Safe; PROCEDURECompileImports ( 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; PROCEDURECheckForLocalName ( 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; PROCEDURECompileExports ( 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; PROCEDUREResolveImportsAndExports ( 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; PROCEDUREErrorHandler ( <*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; PROCEDUREParse ( 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*> PROCEDURENewParser (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; PROCEDURECompileUnit ( 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; M3Error.SetCu(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; PROCEDURECompileGenericInstantiation ( 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; PROCEDURECurrent (): 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); PROCEDUREAddExtension (e: Extension) RAISES {}= BEGIN LOCK extensions_m DO extensions_g := RefList.AppendD(extensions_g, RefList.List1(NEW(ExtensionElem, e := e))); END; (* lock *) END AddExtension; PROCEDURERemoveExtension (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.