File: Module.m3 Last modified on Wed Apr 12 08:36:02 PDT 1995 by kalsow modified on Tue May 25 10:53:07 PDT 1993 by muller
UNSAFE MODULE; IMPORT M3, M3ID, CG, Value, ValueRep, Scope, Stmt, Error, ESet, External; IMPORT Variable, Type, Procedure, Ident, M3Buf, BlockStmt, Int; IMPORT Host, Token, Revelation, Coverage, Decl, Scanner, WebInfo; IMPORT ProcBody, Target, M3RT, Marker, File, Tracer; FROM Scanner IMPORT GetToken, Fail, Match, MatchID, cur; TYPE DataSeg = RECORD size : INTEGER; seg : CG.Var; END; REVEAL T = Value.T BRANDED "Module.T" OBJECT safe : BOOLEAN; interface : BOOLEAN; external : BOOLEAN; has_errors : BOOLEAN; genericBase : M3ID.T; genericFile : TEXT; externals : External.Set; importScope : Scope.T; localScope : Scope.T; revelations : Revelation.Set; block : Stmt.T; body : InitBody; counter : ARRAY [0..4] OF CHAR; fails : ESet.T; body_origin : INTEGER; visit_age : INTEGER; compile_age : INTEGER; globals : ARRAY BOOLEAN (*const*) OF DataSeg; import_offs : INTEGER; last_import : INTEGER; data_name : TEXT; trace : Tracer.T; type_info : Type.ModuleInfo; value_info : Value.T; lazyAligned : BOOLEAN; containsLazyAlignments: BOOLEAN; OVERRIDES typeCheck := TypeCheckMethod; set_globals := ValueRep.NoInit; load := ValueRep.NoLoader; declare := ValueRep.Never; const_init := ValueRep.NoInit; need_init := ValueRep.Never; lang_init := ValueRep.NoInit; user_init := ValueRep.NoInit; toExpr := ValueRep.NoExpr; toType := ValueRep.NoType; typeOf := ValueRep.TypeVoid; base := ValueRep.Self; add_fp_tag := AddFPTag; fp_type := FPType; END; TYPE InitBody = ProcBody.T OBJECT self: T; arg: CG.Var := NIL; OVERRIDES gen_decl := EmitDecl; gen_body := EmitBody; END; TYPE TK = Token.T; VAR (* CONST *) n_builtins : CARDINAL := 0; builtins : ARRAY [0..3] OF RECORD name: M3ID.T; t: T; END; VAR curModule : T := NIL; parseStack : ARRAY [0..200] OF M3ID.T; parseDepth := 0; error_buf : M3Buf.T := NIL; (* used to compose error messages *) visit_age : INTEGER := 0; visit_proc : Visitor := NIL; compile_age := 0; CONST ModuleTypeUID = -1; (* special CG.TypeUID used for all interface records *) CONST InitialCounter = ARRAY [0..4] OF CHAR { '_', '0', '0', '0', '0' }; CONST GlobalDataPrefix = ARRAY (*t.interface*)BOOLEAN OF TEXT { "M_", "I_" }; MainBodySuffix = ARRAY (*t.interface*)BOOLEAN OF TEXT { "_M3", "_I3" }; PROCEDURE Module Reset () = BEGIN curModule := NIL; parseDepth := 0; INC (compile_age); END Reset; PROCEDURECreate (name: M3ID.T): T = VAR t: T; BEGIN t := NEW (T); ValueRep.Init (t, name, Value.Class.Module); t.readonly := TRUE; t.safe := TRUE; t.interface := TRUE; t.external := FALSE; t.has_errors := FALSE; t.genericBase := M3ID.NoID; t.genericFile := NIL; t.externals := External.NewSet (); t.importScope := NIL; t.localScope := NIL; t.block := NIL; t.body := NIL; t.revelations := Revelation.NewSet (t); t.fails := NIL; t.data_name := NIL; t.body_origin := Scanner.offset; t.visit_age := 0; t.compile_age := compile_age; t.globals[FALSE].size := 0; t.globals[FALSE].seg := NIL; t.globals[TRUE].size := 0; t.globals[TRUE].seg := NIL; t.import_offs := -1; t.last_import := 0; t.trace := NIL; t.type_info := NIL; t.value_info := NIL; t.counter := InitialCounter; t.lazyAligned := FALSE; t.containsLazyAlignments := FALSE; RETURN t; END Create; PROCEDURESwitch (new: T): T = VAR old : T := curModule; old_types : Type.ModuleInfo := NIL; old_values : Value.T := NIL; new_types : Type.ModuleInfo := NIL; new_values : Value.T := NIL; BEGIN IF (new # NIL) THEN new_types := new.type_info; new_values := new.value_info; END; old_types := Type.SetModule (new_types); old_values := Value.SetModule (new_values); IF (old # NIL) THEN old.type_info := old_types; old.value_info := old_values; END; curModule := new; RETURN old; END Switch; PROCEDURENewDefn (name: TEXT; safe: BOOLEAN; syms: Scope.T): T = VAR save, t: T; zz: Scope.T; yy: Revelation.Set; BEGIN t := Create (M3ID.Add (name)); WITH z = builtins[n_builtins] DO z.name := t.name; z.t := t; END; INC (n_builtins); t.safe := safe; save := Switch (t); yy := Revelation.Push (t.revelations); zz := Scope.Push (Scope.Initial); t.importScope := Scope.PushNew (TRUE, M3ID.NoID, module := TRUE); IF (syms # NIL) THEN t.localScope := syms; ELSE t.localScope := Scope.PushNew (TRUE, t.name, module := TRUE); Scope.PopNew (); END; Scope.PopNew (); Scope.Pop (zz); Revelation.Pop (yy); RecordInterface (t); EVAL Switch (save); RETURN t; END NewDefn; PROCEDUREParse (interfaceOnly : BOOLEAN := FALSE): T = VAR t, save: T; id: M3ID.T; n: INTEGER; genericReader: File.T; yy: Revelation.Set; topLevel := NOT interfaceOnly; n_errs, n_warns, n_initial_errs: INTEGER; cc: CG.CallingConvention; got_cc: BOOLEAN; BEGIN (* ETimer.Push (M3Timers.parse); *) Error.Count (n_initial_errs, n_warns); t := Create (M3ID.NoID); yy := Revelation.Push (t.revelations); save := Switch (t); IF (cur.token = TK.tEXTERNAL) THEN Decl.ParseExternalPragma (id, cc, got_cc); IF (id # M3ID.NoID) THEN Error.ID (id, "external module name ignored"); END; t.external := TRUE; END; IF (cur.token = TK.tUNSAFE) THEN t.safe := FALSE; GetToken (); END; t.interface := (cur.token = TK.tINTERFACE); IF interfaceOnly THEN IF (cur.token = TK.tINTERFACE) THEN GetToken (); ELSE Fail ("missing INTERFACE keyword"); END; t.interface := TRUE; ELSIF (cur.token = TK.tINTERFACE) OR (cur.token = TK.tMODULE) THEN GetToken (); ELSE Fail ("missing INTERFACE or MODULE keyword"); END; IF t.external AND NOT t.interface THEN Error.Msg ("Only interfaces can be <*EXTERNAL*>"); END; id := MatchID (); t.name := id; IF (t.interface) THEN RecordInterface (t); IF (topLevel) THEN EVAL PushInterface (id); INC (parseDepth) END; END; IF (cur.token = TK.tEXPORTS) THEN IF (t.interface) THEN Error.Msg ("EXPORTS clause not allowed in an interface"); t.interface := FALSE; END; GetToken (); n := Ident.ParseList (); FOR i := 0 TO n - 1 DO External.NoteExport (t.externals, Ident.stack[Ident.top - n + i]); END; DEC (Ident.top, n); ELSIF (NOT t.interface) THEN External.NoteExport (t.externals, t.name); END; IF (cur.token = TK.tSEMI) THEN (* this is a simple module/interface, just fall through *) GetToken (); (* ; *) ELSIF (cur.token = TK.tEQUAL) THEN (* this is an instantiation of a generic module/interface *) GetToken (); (* = *) t.genericBase := PushGeneric (t, genericReader); ELSE Fail ("missing \';\' or \'=\', assuming \';\'"); END; (* parse the imports *) External.ParseImports (t.externals, t); (* build my scopes and fill them! *) t.importScope := Scope.PushNew (TRUE, M3ID.NoID, module := TRUE); (* this scope must be created after the imports & exports are parsed so that their module scopes aren't nested inside this one. *) (* copy the imports and exports into my scope *) External.LoadImports (t.externals, t); (* open my private, local scope *) t.localScope := Scope.PushNew (TRUE, id, module := TRUE); WHILE (cur.token IN Token.DeclStart) DO Decl.Parse (t.interface, TRUE, t.fails); END; t.body_origin := Scanner.offset; IF (topLevel) THEN t.body := NEW (InitBody, self := t, name := BinderName (t.name, t.interface)); ProcBody.Push (t.body); END; IF (NOT t.interface) THEN Match (TK.tBEGIN); t.trace := BlockStmt.ParseTrace (); t.block := Stmt.Parse (); END; IF (topLevel) THEN ProcBody.Pop (); END; IF (t.genericBase # M3ID.NoID) THEN ParseFinalEndID (t.genericBase); Scanner.Pop (); END; Host.CloseFile (genericReader); ParseFinalEndID (t.name); Scope.PopNew (); (* localScope *) Scope.PopNew (); (* importScope *) Revelation.Pop (yy); IF (t.interface) AND (topLevel) THEN DEC (parseDepth) END; EVAL Switch (save); Error.Count (n_errs, n_warns); IF (n_errs > n_initial_errs) THEN t.has_errors := TRUE; END; (* ETimer.Pop (); *) RETURN t; END Parse; PROCEDUREPushGeneric (t: T; VAR rd: File.T): M3ID.T =
instantiate a call on a generic interface or module
VAR genericName, id : M3ID.T; nActuals, aBase : INTEGER; nFormals, fBase : INTEGER; formal, actual : M3ID.T; filename: TEXT; im: T; old_file := Scanner.offset; save: INTEGER; old_filename: TEXT; BEGIN Scanner.Here (old_filename, save); genericName := MatchID (); IF (genericName = M3ID.NoID) THEN RETURN genericName END; (* parse the list of actuals *) nActuals := ParseGenericArgs (); (* open the external file *) rd := Host.OpenUnit (genericName, t.interface, TRUE, filename); IF (rd = NIL) THEN Error.ID (genericName, "unable to find generic"); RETURN M3ID.NoID; END; (* build a synthetic file name & start reading *) filename := old_filename & " => " & filename; Scanner.Push (filename, rd, is_main := Scanner.in_main); t.genericFile := filename; (* make sure we got what we wanted *) Match (TK.tGENERIC); IF (t.interface) THEN Match (TK.tINTERFACE); ELSE Match (TK.tMODULE); END; (* get the generic's name *) id := MatchID (); IF (id # M3ID.NoID) THEN IF (id # genericName) THEN Error.ID (id, "imported module has wrong name"); genericName := id; END; END; (* parse the list of formals *) nFormals := ParseGenericArgs (); Match (TK.tSEMI); (* finally, generate the rewriting *) IF (nActuals # nFormals) THEN save := Scanner.offset; Scanner.offset := old_file; Error.Msg ("number of actuals doesn\'t match number of generic formals"); Scanner.offset := save; END; fBase := Ident.top - nFormals; aBase := fBase - nActuals; FOR i := 0 TO MAX (nActuals, nFormals)-1 DO IF (i < nFormals) THEN formal := Ident.stack[fBase + i]; ELSE formal := Ident.stack[aBase + i]; (* use the actual instead *) END; IF (i < nActuals) THEN actual := Ident.stack[aBase + i]; ELSE actual := formal; (* use the actual instead *) END; im := LookUp (actual, internal := FALSE); External.NoteImport (t.externals, im, formal); END; DEC (Ident.top, nActuals + nFormals); RETURN genericName; END PushGeneric; PROCEDUREParseGenericArgs (): INTEGER = VAR n := 0; BEGIN Match (TK.tLPAREN); IF (cur.token = TK.tIDENT) THEN n := Ident.ParseList (); END; Match (TK.tRPAREN); RETURN n; END ParseGenericArgs; PROCEDUREParseFinalEndID (goal: M3ID.T) = VAR id: M3ID.T; BEGIN Match (TK.tEND); id := MatchID (); IF (goal # id) THEN Error.ID (id, "Initial module name doesn\'t match final name"); END; Match (TK.tDOT); IF (cur.token # TK.tEOF) THEN Fail ("extra tokens ignored"); END; END ParseFinalEndID; PROCEDUREPushInterface (name: M3ID.T): BOOLEAN = VAR i: INTEGER; BEGIN (* check for a cycle in the active imports *) parseStack [parseDepth] := name; i := 0; WHILE (parseStack[i] # name) DO INC (i) END; IF (i = parseDepth) THEN RETURN TRUE END; IF (error_buf = NIL) THEN error_buf := M3Buf.New (); END; M3ID.Put (error_buf, name); FOR j := i+1 TO parseDepth DO M3Buf.PutText (error_buf, " -> "); M3ID.Put (error_buf, parseStack [j]); END; Error.Txt (M3Buf.ToText (error_buf), "circular imports"); RETURN FALSE; END PushInterface; PROCEDURELookUp (name: M3ID.T; internal: BOOLEAN): T = (* find and return the named interface module *) VAR t: T; save: INTEGER; filename: TEXT; cs := M3.OuterCheckState; rd: File.T; BEGIN IF NOT internal THEN IF NOT PushInterface (name) THEN RETURN NIL END; END; t := Host.env.find_ast (name); IF (t # NIL) THEN IF (t.has_errors) THEN Error.ID (name, "imported interface contains errors"); END; MakeCurrent (t); ELSE (* open the external file & parse the interface*) rd := Host.OpenUnit (name, TRUE, FALSE, filename); IF (rd = NIL) THEN Error.ID (name, "unable to find interface"); RETURN NIL; END; Scanner.Push (filename, rd, is_main := FALSE); INC (parseDepth); t := Parse (TRUE); DEC (parseDepth); Scanner.Pop (); Host.CloseFile (rd); rd := NIL; (* make sure we got what we wanted *) IF (t = NIL) THEN Error.ID (name, "imported object is not an interface"); RETURN NIL; END; IF (t.name # name) THEN save := Scanner.offset; Scanner.offset := t.origin; Error.ID (name, "imported interface has wrong name"); Scanner.offset := save; RETURN NIL; END; IF (NOT t.interface) THEN save := Scanner.offset; Scanner.offset := t.origin; Error.ID (name, "imported unit is not an interface"); Scanner.offset := save; RETURN NIL; END; RecordInterface (t); Value.TypeCheck (t, cs); END; IF (curModule # NIL) AND (curModule.safe) AND (NOT t.safe) AND (NOT internal) THEN Error.ID (name, "cannot import an unsafe interface in a safe module"); END; RETURN t; END LookUp; PROCEDUREMakeCurrent (t: T) = BEGIN IF (t # NIL) AND (t.compile_age < compile_age) THEN t.compile_age := compile_age; t.globals[FALSE].seg := NIL; t.globals[TRUE].seg := NIL; t.import_offs := -1; t.last_import := 0; t.used := FALSE; t.imported := TRUE; t.exported := FALSE; Value.Reuse (t.value_info); Revelation.Reuse (t.revelations); External.Visit (t.externals, MakeCurrent); END; END MakeCurrent; PROCEDURERecordInterface (t: T) = (* we must be careful not to overwrite the cached values of the builtin interfaces (e.g. Word), because the versions generated from source don't have the special procedure methods needed for code generation and constant evaluation. *) BEGIN IF (t = NIL) OR (t.name = M3ID.NoID) THEN RETURN END; FOR i := 0 TO n_builtins-1 DO WITH z = builtins[i] DO IF (z.name = t.name) AND (t # z.t) THEN RETURN END; END; END; Host.env.note_ast (t.name, t); END RecordInterface; PROCEDUREImportRevelations (t: T; source: Value.T) = BEGIN Revelation.Inherit (t.revelations, source); END ImportRevelations; PROCEDURETypeCheckMethod (t: T; VAR cs: Value.CheckState) = BEGIN TypeCheck (t, FALSE, cs); END TypeCheckMethod; PROCEDURETypeCheck (t: T; main: BOOLEAN; VAR cs: Value.CheckState) = VAR save: T; yy: Revelation.Set; z1, z2: Scope.T; save_main: BOOLEAN; n_errs, n_warns, n_initial_errs: INTEGER; BEGIN IF (t.checked) THEN RETURN END; (* ETimer.Push (M3Timers.check); *) Error.Count (n_initial_errs, n_warns); save := Switch (t); save_main := Scanner.in_main; Scanner.in_main := main; yy := Revelation.Push (t.revelations); SoftPush (t.importScope, z1); Scope.TypeCheck (t.importScope, cs); SoftPush (t.localScope, z2); ESet.TypeCheck (t.fails); ESet.Push (cs, NIL, t.fails, stop := TRUE); Revelation.TypeCheck (t.revelations); Scope.TypeCheck (t.localScope, cs); IF (NOT t.interface) THEN BlockStmt.CheckTrace (t.trace, cs); Stmt.TypeCheck (t.block, cs); END; ESet.Pop (cs, NIL, t.fails, stop := TRUE); SoftPop (t.localScope, z2); SoftPop (t.importScope, z1); Revelation.Pop (yy); CheckDuplicates (t); IF (main) THEN NoteVisibility (t); Scope.WarnUnused (t.importScope); Scope.WarnUnused (t.localScope); END; Error.Count (n_errs, n_warns); IF (n_errs > n_initial_errs) THEN t.has_errors := TRUE; END; SetGlobals (t); Scanner.in_main := save_main; EVAL Switch (save); Error.Count (n_errs, n_warns); IF (n_errs > n_initial_errs) THEN t.has_errors := TRUE; END; (* ETimer.Pop (); *) (* This is a horrible hack! Since we want to call Module.TypeCheck with "main:=TRUE" directly from M3Compiler.Compile, we bypass the normal flag setting done by Value.TypeCheck. *) t.checkDepth := 0; t.checked := TRUE; END TypeCheck; PROCEDURESoftPush (s: Scope.T; VAR tmp: Scope.T) = (* the scopes may be NIL when there's illegal cycles in the import graph *) BEGIN IF (s # NIL) THEN tmp := Scope.Push (s) END; END SoftPush; PROCEDURESoftPop (s: Scope.T; tmp: Scope.T) = BEGIN IF (s # NIL) THEN Scope.Pop (tmp) END; END SoftPop; PROCEDURESetGlobals (t: T) = (* Interface record offsets are allocated here. We don't allocate them during typechecking, since the order is unpredictable. Here, the offsets are allocated to objects in the order that they appear in the source. *) VAR v := Scope.ToList (t.localScope); BEGIN IF (t.has_errors) THEN (*don't bother *) RETURN END; IF (Host.verbose) OR (Host.load_map AND Scanner.in_main) THEN Out (TRUE, Target.EOL, Target.EOL, " global constants for "); Out (TRUE, DataName (t), Target.EOL); Out (FALSE, Target.EOL, Target.EOL, " global data allocation for "); Out (FALSE, DataName (t), Target.EOL); END; IF (t.globals[FALSE].size = 0) THEN EVAL Allocate (M3RT.MI_SIZE, Target.Address.align, FALSE, "*module info*"); END; Type.BeginSetGlobals (); WHILE (v # NIL) DO Type.SetGlobals (v.origin); Value.SetGlobals (v); v := v.next; END; Type.SetGlobals (LAST (INTEGER)); END SetGlobals; PROCEDUREAllocate (size, align: INTEGER; is_const : BOOLEAN; tag: TEXT := NIL; id: M3ID.T := M3ID.NoID): INTEGER = VAR offset: INTEGER; BEGIN align := MAX (align, Target.Byte); align := (align + Target.Byte - 1) DIV Target.Byte * Target.Byte; size := (size + Target.Byte - 1) DIV Target.Byte * Target.Byte; offset := (curModule.globals[is_const].size + align - 1) DIV align * align; curModule.globals[is_const].size := offset + size; IF (Host.verbose) OR (Host.load_map AND Scanner.in_main) THEN OutI (offset DIV Target.Byte, 6, is_const); OutI (size DIV Target.Byte, 6, is_const); OutI (align DIV Target.Byte, 3, is_const); Out (is_const, " ", tag); IF (id # M3ID.NoID) THEN M3ID.Put (load_map[is_const], id); END; Out (is_const, Target.EOL); END; RETURN offset; END Allocate; VAR load_map := ARRAY BOOLEAN (*is_const*) OF M3Buf.T { NIL, NIL }; CONST Pads = ARRAY [0..5] OF TEXT { "", " ", " ", " ", " ", " " }; PROCEDUREInitLoadMap () = BEGIN IF (load_map[FALSE] = NIL) THEN load_map[FALSE] := M3Buf.New (); load_map[TRUE] := M3Buf.New (); END; END InitLoadMap; PROCEDUREOutI (n, width: INTEGER; is_const: BOOLEAN) = VAR x := 10; pad := width - 1; BEGIN IF (load_map[FALSE] = NIL) THEN InitLoadMap (); END; WHILE (pad > 0) AND (n >= x) DO DEC (pad); x := 10*x; END; IF (pad > 0) THEN M3Buf.PutText (load_map[is_const], Pads[pad]) END; M3Buf.PutInt (load_map[is_const], n); END OutI; PROCEDUREOut (is_const: BOOLEAN; a, b, c, d: TEXT := NIL) = BEGIN IF (load_map[FALSE] = NIL) THEN InitLoadMap (); END; IF (a # NIL) THEN M3Buf.PutText (load_map[is_const], a) END; IF (b # NIL) THEN M3Buf.PutText (load_map[is_const], b) END; IF (c # NIL) THEN M3Buf.PutText (load_map[is_const], c) END; IF (d # NIL) THEN M3Buf.PutText (load_map[is_const], d) END; END Out; PROCEDURECheckDuplicates (t: T) = VAR v, v2 : Value.T; save := Scanner.offset; BEGIN M3ID.AdvanceMarks (); (* mark all the imports *) v := Scope.ToList (t.importScope); WHILE (v # NIL) DO EVAL M3ID.SetMark (v.name); v := v.next; END; (* check for anything already marked in the local scope *) v := Scope.ToList (t.localScope); WHILE (v # NIL) DO IF M3ID.SetMark (v.name) THEN v2 := Scope.LookUp (t.importScope, v.name, strict := TRUE); IF (v2 # NIL) THEN (* possible duplicate *) IF (NOT External.IsExportable (v2)) OR (Value.ClassOf (v) # Value.Class.Procedure) OR (Value.ClassOf (v2) # Value.Class.Procedure) THEN Scanner.offset := v.origin; Error.ID (v.name, "symbol redefined"); ELSE Procedure.NoteExport (v, v2); External.Redirect (v2, v); END; END; END; v := v.next; END; Scanner.offset := save; END CheckDuplicates; PROCEDURENoteVisibility (t: T) = VAR v := Scope.ToList (t.localScope); BEGIN WHILE (v # NIL) DO CASE Value.ClassOf (v) OF | Value.Class.Module, Value.Class.Error => (* no change of import/export status *) | Value.Class.Expr, Value.Class.Var, Value.Class.Type, Value.Class.Exception => IF (t.interface) THEN <*ASSERT NOT v.imported*> v.exported := TRUE; v.exportable := TRUE; (* ELSE no change of import/export status *) END; | Value.Class.Procedure => <*ASSERT NOT v.imported*> IF (t.interface) THEN v.used := TRUE; (* force a version stamp *) v.exported := TRUE; v.imported := FALSE; (***** v.exported := v.external; v.imported := NOT v.exported; ****) v.exportable := TRUE; END; | Value.Class.Field, Value.Class.Method, Value.Class.Formal => <* ASSERT FALSE *> END; v := v.next; END; END NoteVisibility; PROCEDUREIsSafe (): BOOLEAN = BEGIN RETURN (curModule = NIL) OR (curModule.safe); END IsSafe; PROCEDUREIsInterface (): BOOLEAN = BEGIN RETURN (curModule = NIL) OR (curModule.interface); END IsInterface; PROCEDUREIsExternal (): BOOLEAN = BEGIN RETURN (curModule # NIL) AND (curModule.external); END IsExternal; PROCEDURELazyAlignmentOn (): BOOLEAN = BEGIN RETURN curModule # NIL AND curModule.lazyAligned; END LazyAlignmentOn; PROCEDURESetLazyAlignment (on: BOOLEAN) = BEGIN IF curModule # NIL THEN curModule.lazyAligned := on; IF on THEN curModule.containsLazyAlignments := TRUE; END; END; END SetLazyAlignment; PROCEDUREExportScope (t: T): Scope.T = BEGIN IF (t = NIL) THEN RETURN NIL; ELSE RETURN t.localScope; END; END ExportScope; PROCEDURECompile (t: T) = VAR save: T; zz: Scope.T; yy: Revelation.Set; BEGIN (* ETimer.Push (M3Timers.emit); *) Target.Allow_packed_byte_aligned := t.containsLazyAlignments; save := Switch (t); Scanner.offset := t.origin; yy := Revelation.Push (t.revelations); zz := Scope.Push (t.localScope); WebInfo.Reset (); CG.Begin_unit (); CG.Gen_location (t.origin); Host.env.note_unit (t.name, t.interface); DeclareGlobalData (t); IF (t.body # NIL) THEN EmitDecl (t.body); END; Type.CompileAll (); IF (t.interface) THEN CompileInterface (t); ELSE CompileModule (t); END; IF (load_map[FALSE] # NIL) THEN CG.Comment (-1, FALSE, "load map", Target.EOL, M3Buf.ToText (load_map[FALSE]), M3Buf.ToText (load_map[TRUE])); load_map[FALSE] := NIL; load_map[TRUE] := NIL; END; CG.End_unit (); Host.env.note_webinfo (WebInfo.Finish ()); Scope.Pop (zz); Revelation.Pop (yy); EVAL Switch (save); (* ETimer.Pop (); *) END Compile; PROCEDURECompileInterface (t: T) = VAR proc_info, type_map, rev_full, rev_part: INTEGER; BEGIN (* declare the modules that I import & export *) (** EVAL GlobalData (t); **) CG.Export_unit (t.name); Host.env.note_interface_use (t.name, imported := FALSE); IF (t.genericBase # M3ID.NoID) THEN Host.env.note_generic_use (t.genericBase); END; External.GenLinkInfo (t.externals); ImportImplementations (); (* declare my imports, exports and local variables *) External.GenImports (t.externals); Scope.Enter (t.importScope); Scope.Enter (t.localScope); (* declare any visible revelations *) Revelation.Declare (t.revelations, rev_full, rev_part); (* generate any internal procedures *) ProcBody.EmitAll (proc_info); type_map := Variable.GenGlobalMap (t.localScope); GenLinkerInfo (t, proc_info, type_map, rev_full, rev_part); END CompileInterface; PROCEDURECompileModule (t: T) = VAR proc_info, type_map, rev_full, rev_part: INTEGER; BEGIN (* declare the modules that I import & export *) IF (t.genericBase # M3ID.NoID) THEN Host.env.note_generic_use (t.genericBase); END; External.GenLinkInfo (t.externals); (* declare my imports, exports and local variables *) (**** moved below **** External.GenImports (t.externals); *) Scope.Enter (t.importScope); Scope.Enter (t.localScope); (* declare any visible revelations *) Revelation.Declare (t.revelations, rev_full, rev_part); (* generate the tables for coverage *) Coverage.GenerateTables (); (* generate any internal procedures *) ProcBody.EmitAll (proc_info); type_map := Variable.GenGlobalMap (t.localScope); (* declare my imports *) External.GenImports (t.externals); (* we deferred the import declarations until all the code has been generated to pick up imports that are used via "Value.Load", but not "Scope.LookUp". *) GenLinkerInfo (t, proc_info, type_map, rev_full, rev_part); END CompileModule; PROCEDUREDeclareGlobalData (t: T) = BEGIN CG.Comment (-1, FALSE, "module global constants"); t.globals[TRUE].seg := CG.Declare_segment (M3ID.NoID, ModuleTypeUID, is_const := TRUE); CG.Comment (-1, FALSE, "module global data"); t.globals[FALSE].seg := CG.Declare_segment (M3ID.Add (DataName (t)), ModuleTypeUID, is_const := FALSE); END DeclareGlobalData; PROCEDUREGlobalData (is_const: BOOLEAN): CG.Var = BEGIN <*ASSERT curModule.compile_age >= compile_age*> RETURN curModule.globals[is_const].seg; END GlobalData; PROCEDURELoadGlobalAddr (t: T; offset: INTEGER; is_const: BOOLEAN) = BEGIN <*ASSERT t.compile_age >= compile_age*> IF (t = curModule) THEN CG.Load_addr_of (t.globals[is_const].seg, offset, CG.Max_alignment); ELSE <*ASSERT NOT is_const*> ImportInterface (t); CG.Load_addr (curModule.globals[FALSE].seg, t.import_offs + M3RT.II_import); CG.Boost_alignment (CG.Max_alignment); CG.Add_offset (offset); END; END LoadGlobalAddr; PROCEDUREImportInterface (t: T) = BEGIN <*ASSERT t.compile_age >= compile_age*> IF (t # curModule) AND (t.import_offs < 0) THEN (* this is the first reference to the imported interface 't' *) t.import_offs := BuildImportLink (t.name, BinderName (t.name, t.interface)); END; END ImportInterface; PROCEDUREBuildImportLink (nm: M3ID.T; binder: TEXT): INTEGER = VAR new_proc : BOOLEAN; prev_link : INTEGER; offset := Allocate (M3RT.II_SIZE, Target.Address.align, FALSE, "import ", nm); proc := CG.Import_procedure (M3ID.Add (binder), 0, CG.Type.Addr, Target.DefaultCall, new_proc); BEGIN IF (curModule.last_import = 0) THEN prev_link := M3RT.MI_imports; ELSE prev_link := curModule.last_import + M3RT.II_next; END; curModule.last_import := offset; CG.Init_var (prev_link, curModule.globals[FALSE].seg, offset, FALSE); CG.Init_proc (offset + M3RT.II_binder, proc, FALSE); RETURN offset; END BuildImportLink; PROCEDUREImportImplementations () = (* Generate the import and initialization links that cause the importer of an interface to also bind to the implementations of that interface. *) VAR x := Host.env.get_implementations (curModule.name); BEGIN WHILE (x # NIL) DO EVAL BuildImportLink (x.impl, BinderName (x.impl, interface := FALSE)); x := x.next; END; END ImportImplementations; PROCEDUREEmitDecl (x: InitBody) = VAR t := x.self; BEGIN IF (x.cg_proc # NIL) THEN RETURN END; Scanner.offset := t.body_origin; CG.Gen_location (t.body_origin); x.cg_proc := CG.Declare_procedure (M3ID.Add (x.name), 1, CG.Type.Addr, lev := 0, cc := Target.DefaultCall, exported := TRUE, parent := NIL); x.arg := CG.Declare_param (M3ID.Add ("mode"), Target.Integer.size, Target.Integer.align, Target.Integer.cg_type, Type.GlobalUID (Int.T), (*in_memory*) FALSE, (*up_level*) FALSE, (*frequency*) CG.Always); END EmitDecl; PROCEDUREEmitBody (x: InitBody) = VAR t := x.self; zz: Scope.T; skip := CG.Next_label (); BEGIN IF (x.cg_proc = NIL) THEN RETURN END; (* restore my environment *) zz := Scope.Push (t.localScope); (* generate my initialization procedure *) CG.Comment (-1, FALSE, "module main body ", x.name); Scanner.offset := t.body_origin; CG.Gen_location (t.body_origin); CG.Begin_procedure (x.cg_proc); CG.Load_int (Target.Integer.cg_type, x.arg); CG.If_false (skip, CG.Never); Scope.InitValues (t.importScope); Scope.InitValues (t.localScope); (* initialize my exported variables *) External.InitGlobals (t.externals); (* perform the main body *) Tracer.Push (t.trace); EVAL Stmt.Compile (t.block); Tracer.Pop (t.trace); CG.Set_label (skip); CG.Load_addr_of (t.globals[FALSE].seg, 0, CG.Max_alignment); CG.Exit_proc (CG.Type.Addr); CG.End_procedure (x.cg_proc); Scope.Pop (zz); END EmitBody; PROCEDUREGenLinkerInfo (t: T; proc_info, type_map, rev_full, rev_part: INTEGER) = VAR v := t.globals[FALSE].seg; vc := t.globals[TRUE].seg; file: TEXT; line, offs: INTEGER; type_cells, type_cell_ptrs: INTEGER; exception_scopes := Marker.EmitScopeTable (); BEGIN Scanner.offset := t.origin; IF (t.genericFile # NIL) THEN offs := CG.EmitText (t.genericFile, is_const := TRUE); ELSE Scanner.Here (file, line); offs := CG.EmitText (file, is_const := TRUE); END; CG.Init_var (M3RT.MI_file, vc, offs, is_const := FALSE); CG.Comment (offs, TRUE, "file name"); type_cells := Type.GenCells (); type_cell_ptrs := Type.GenCellPtrs (); (* note: the type info cannot be generated until *all* types have have been declared *) IF (type_cells >= 0) THEN CG.Init_var (M3RT.MI_type_cells, v, type_cells, FALSE); END; IF (type_cell_ptrs >= 0) THEN CG.Init_var (M3RT.MI_type_cell_ptrs, v, type_cell_ptrs, FALSE); END; IF (rev_full >= 0) THEN CG.Init_var (M3RT.MI_full_rev, vc, rev_full, FALSE); END; IF (rev_part >= 0) THEN CG.Init_var (M3RT.MI_part_rev, vc, rev_part, FALSE); END; IF (proc_info >= 0) THEN CG.Init_var (M3RT.MI_proc_info, vc, proc_info, FALSE); END; IF (exception_scopes >= 0) THEN CG.Init_var (M3RT.MI_try_scopes, vc, exception_scopes, FALSE); END; IF (type_map >= 0) THEN CG.Init_var (M3RT.MI_var_map, vc, type_map, FALSE); CG.Init_var (M3RT.MI_gc_map, vc, type_map, FALSE); END; IF (t.body # NIL) AND (t.body.cg_proc # NIL) THEN CG.Init_proc (M3RT.MI_binder, t.body.cg_proc, FALSE); END; IF (Host.doIncGC) AND (Host.doGenGC) THEN CG.Init_intt (M3RT.MI_gc_flags, Target.Integer.size, 3, FALSE); ELSIF (Host.doIncGC) THEN CG.Init_intt (M3RT.MI_gc_flags, Target.Integer.size, 2, FALSE); ELSIF (Host.doGenGC) THEN CG.Init_intt (M3RT.MI_gc_flags, Target.Integer.size, 1, FALSE); END; (* finish up the global data segment allocations *) EVAL Allocate (0, Target.Address.align, FALSE, "*TOTAL*"); EVAL Allocate (0, Target.Address.align, TRUE, "*TOTAL*"); (* generate a debugging type descriptor for the global data *) CG.Comment (-1, FALSE, "global constant type descriptor"); CG.Emit_global_record (t.globals[TRUE].size, TRUE); CG.Comment (-1, FALSE, "global data type descriptor"); CG.Emit_global_record (t.globals[FALSE].size, FALSE); (* finish the global data initializations *) CG.Comment (-1, TRUE, "module global constants"); CG.Bind_segment (t.globals[TRUE].seg, t.globals[TRUE].size, CG.Max_alignment, CG.Type.Struct, exported := FALSE, init := TRUE, is_const := TRUE); CG.Comment (-1, FALSE, "module global data"); CG.Bind_segment (t.globals[FALSE].seg, t.globals[FALSE].size, CG.Max_alignment, CG.Type.Struct, exported := FALSE, init := TRUE, is_const := FALSE); END GenLinkerInfo; PROCEDUREAddFPTag (t: T; VAR x: M3.FPInfo): CARDINAL = CONST Tags = ARRAY BOOLEAN OF TEXT { "MODULE ", "INTERFACE " }; BEGIN ValueRep.FPStart (t, x, Tags[t.interface], 0, global := FALSE); RETURN 0; END AddFPTag; PROCEDUREFPType (<*UNUSED*> t: T): Type.T = BEGIN RETURN NIL; END FPType; PROCEDURECurrent (): T = BEGIN RETURN curModule; END Current; PROCEDUREName (t: T): M3ID.T = BEGIN IF (t = NIL) THEN t := curModule; END; IF (t = NIL) THEN RETURN M3ID.NoID; END; RETURN t.name; END Name; PROCEDUREDataName (t: T): TEXT = BEGIN IF (t = NIL) THEN t := curModule; END; IF (t = NIL) THEN RETURN ""; END; IF (t.data_name = NIL) THEN t.data_name := GlobalDataPrefix [t.interface] & M3ID.ToText (t.name); END; RETURN t.data_name; END DataName; PROCEDUREBinderName (nm: M3ID.T; interface: BOOLEAN): TEXT = BEGIN RETURN M3ID.ToText (nm) & MainBodySuffix[interface]; END BinderName; PROCEDUREGetNextCounter (VAR c: ARRAY [0..4] OF CHAR) = BEGIN <* ASSERT curModule # NIL *> WITH cnt = curModule.counter DO c := curModule.counter; (* bump the counter *) FOR j := LAST (cnt) TO FIRST (cnt) BY -1 DO IF (cnt[j] = '9') THEN cnt[j] := '0'; ELSE cnt[j] := VAL (ORD (cnt[j]) + 1, CHAR); EXIT; END; END; END; END GetNextCounter; PROCEDUREGetTypeInfo (t: T): Type.ModuleInfo = BEGIN RETURN t.type_info; END GetTypeInfo; PROCEDUREVisitImports (v: Visitor) = BEGIN <*ASSERT visit_proc = NIL *> visit_proc := v; INC (visit_age); External.Visit (curModule.externals, InnerVisit); visit_proc := NIL; END VisitImports; PROCEDUREInnerVisit (t: T) = BEGIN IF (t # NIL) AND (t.visit_age < visit_age) THEN t.visit_age := visit_age; External.Visit (t.externals, InnerVisit); visit_proc (t); END; END InnerVisit; BEGIN END Module.