MODULE------------------------------------------------------------------------; IMPORT Wr, Thread, Stdio; IMPORT Mx, MxRep, MxMap, M3ID, Target; IMPORT M3CG, M3CG_Ops, TInt, TargetMap; CONST (* name-mangling done by the compiler & back-end *) BinderSuffix = ARRAY BOOLEAN OF TEXT { "_M3", "_I3" }; TYPE State = RECORD base : Mx.LinkSet := NIL; errors : Wr.T := NIL; verbose : BOOLEAN := FALSE; gui : BOOLEAN := FALSE; genC : BOOLEAN := FALSE; main_units : UnitInfo := NIL; (* C output information *) wr : Wr.T := NIL; eol : TEXT := NIL; (* M3CG output information *) cg : M3CG.T := NIL; END; TYPE UnitInfo = REF RECORD next : UnitInfo; unit : Mx.Unit; cg_proc : M3CG.Proc := NIL; binder : TEXT; END; MxGen
PROCEDURE------------------------------------------------------------------------GenerateMain (base: Mx.LinkSet; c_output: Wr.T; cg_output: M3CG.T; verbose: BOOLEAN; windowsGUI: BOOLEAN) = VAR s: State; BEGIN <*ASSERT (c_output = NIL) # (cg_output = NIL) *> s.base := base; s.wr := c_output; s.cg := cg_output; s.verbose := verbose; s.errors := Stdio.stdout; s.gui := windowsGUI; s.genC := (s.wr # NIL); s.eol := Target.EOL; IF s.genC THEN GenCTypeDecls (s); ELSE GenCGTypeDecls (s); END; ImportMain (s); IF s.genC THEN GenerateCEntry (s); ELSE GenerateCGEntry (s); END; END GenerateMain;
PROCEDURE------------------------------------------------------------------------GenCTypeDecls (<*UNUSED*> VAR s: State) = BEGIN END GenCTypeDecls; PROCEDUREGenCGTypeDecls (VAR s: State) = VAR interface : M3CG.Var; struct_align := MAX (Target.Structure_size_boundary, Target.Address.align) DIV Target.Byte; (* == min structure alignment (bytes)*) BEGIN s.cg.begin_unit (); s.cg.set_source_file ("_m3main.mc"); s.cg.set_source_line (1); (* we only need to declare a global segment so the gcc-based backend can pick up the unit name, "_m3main". But then, the native x86 backend requires that it be explicitly initialized... *) interface := s.cg.declare_segment (M3ID.Add ("MM__m3main"), 0, FALSE); s.cg.bind_segment (interface, Target.Address.bytes, struct_align, Target.CGType.Struct, FALSE, TRUE); s.cg.begin_init (interface); s.cg.end_init (interface); END GenCGTypeDecls;
PROCEDURE------------------------------------------------------------------------ImportMain (VAR s: State) = VAR main := M3ID.Add ("Main"); units := MxMap.GetData (s.base.modules); u : Mx.Unit; BEGIN s.main_units := NIL; (* find the modules exporting "Main" *) FOR i := 0 TO LAST (units^) DO u := units[i].value; IF (u # NIL) THEN FOR i := u.exported_units.start TO u.exported_units.start + u.exported_units.cnt - 1 DO IF (u.info[i] = main) THEN s.main_units := NEW (UnitInfo, unit := u, next := s.main_units); ImportUnit (s, s.main_units); EXIT; END; END; END; END; IF s.main_units = NIL THEN Err (s, "No module implements \"Main\".", s.eol); END; END ImportMain; PROCEDUREImportUnit (VAR s: State; ui: UnitInfo) = VAR u := ui.unit; BEGIN ui.binder := M3ID.ToText (u.name) & BinderSuffix [u.interface]; IF s.genC THEN Out (s, "extern void* ", ui.binder, "();", s.eol); ELSE ui.cg_proc := s.cg.import_procedure (M3ID.Add (ui.binder), 1, Target.CGType.Addr, Target.DefaultCall); EVAL DeclareParam (s, "mode", Target.Integer.cg_type); END; END ImportUnit;
PROCEDURE------------------------------------------------------------------------GenerateCEntry (VAR s: State) = VAR ui: UnitInfo; BEGIN Out (s, "extern void RTLinker__InitRuntime ();", s.eol); Out (s, "extern void RTLinker__AddUnit ();", s.eol); Out (s, "extern void RTProcess__Exit ();", s.eol, s.eol); IF (s.gui) THEN Out (s, "#include <windows.h>", s.eol); Out (s, "int WINAPI "); Out (s, "WinMain (HINSTANCE self, HINSTANCE prev,", s.eol); Out (s, " LPSTR args, int mode)", s.eol); Out (s, "{", s.eol); Out (s, " RTLinker__InitRuntime (-1, args, "); Out (s, "GetEnvironmentStringsA(), self);", s.eol); ELSE Out (s, "int main (argc, argv, envp)", s.eol); Out (s, "int argc;", s.eol); Out (s, "char **argv;", s.eol); Out (s, "char **envp;", s.eol); Out (s, "{", s.eol); Out (s, " RTLinker__InitRuntime (argc, argv, envp, 0);", s.eol); END; ui := s.main_units; WHILE (ui # NIL) DO Out (s, " RTLinker__AddUnit (", ui.binder, ");", s.eol); ui := ui.next; END; Out (s, " RTProcess__Exit (0);", s.eol); Out (s, " return 0;", s.eol); Out (s, "}", s.eol, s.eol); END GenerateCEntry;
PROCEDURE------------------------------------------------------------------------GenerateCGEntry (VAR s: State) = VAR main : M3CG.Proc; run_proc : M3CG.Proc; link_proc : M3CG.Proc; exit_proc : M3CG.Proc; getenv : M3CG.Proc; winapi : Target.CallingConvention; argv : M3CG.Var; argc : M3CG.Var; envp : M3CG.Var; self : M3CG.Var; prev : M3CG.Var; mode : M3CG.Var; src_line : INTEGER := 2; ui : UnitInfo; int_t := Target.Integer.cg_type; addr_t := Target.CGType.Addr; BEGIN run_proc := s.cg.import_procedure (M3ID.Add ("RTLinker__InitRuntime"), 4, Target.CGType.Void, Target.DefaultCall); EVAL DeclareParam (s, "argc", int_t); EVAL DeclareParam (s, "argv", addr_t); EVAL DeclareParam (s, "envp", addr_t); EVAL DeclareParam (s, "instance", addr_t); link_proc := s.cg.import_procedure (M3ID.Add ("RTLinker__AddUnit"), 1, Target.CGType.Void, Target.DefaultCall); EVAL DeclareParam (s, "m", addr_t); exit_proc := s.cg.import_procedure (M3ID.Add ("RTProcess__Exit"), 1, Target.CGType.Void, Target.DefaultCall); EVAL DeclareParam (s, "n", int_t); IF (s.gui) THEN (* #include <windows.h> extern LPSTR WINAPI GetEnvironmentStringsA (); *) winapi := Target.FindConvention ("WINAPI"); getenv := s.cg.import_procedure (M3ID.Add ("GetEnvironmentStringsA"), 0, addr_t, winapi); (* int WINAPI WinMain(HINSTANCE self, HINSTANCE prev, LPSTR args, int mode) *) main := s.cg.declare_procedure (M3ID.Add ("WinMain"), (*n_params*) 4, int_t, (*lev*) 0, winapi, TRUE, NIL); self := DeclareParam (s, "self", addr_t); prev := DeclareParam (s, "prev", addr_t); argv := DeclareParam (s, "args", addr_t); mode := DeclareParam (s, "mode", int_t); s.cg.begin_procedure(main); (* int argc; void *envp; *) argc := DeclareLocal (s, "argc", int_t); envp := DeclareLocal (s, "envp", addr_t); (* argc = -1; *) s.cg.set_source_line (src_line); INC (src_line); s.cg.load_integer (int_t, TInt.MOne); s.cg.store (argc, 0, int_t, int_t); (* envp = (_ADDRESS)GetEnvironmentStringsA(); *) s.cg.set_source_line (src_line); INC (src_line); s.cg.start_call_direct (getenv, 0, addr_t); s.cg.call_direct (getenv, addr_t); s.cg.store (envp, 0, addr_t, addr_t); ELSE (* not GUI *) (* int main (int argc, char **argv, char **envp) *) main := s.cg.declare_procedure (M3ID.Add("main"), (*n_params*) 3, int_t, (*lev*) 0, Target.DefaultCall, TRUE, NIL); argc := DeclareParam (s, "argc", int_t); argv := DeclareParam (s, "argv", addr_t); envp := DeclareParam (s, "envp", addr_t); s.cg.begin_procedure(main); (* void * self; *) self := DeclareLocal (s, "self", addr_t); (* self = 0; *) s.cg.set_source_line (src_line); INC (src_line); s.cg.load_integer (int_t, TInt.Zero); s.cg.store (self, 0, int_t, int_t); END; (* if GUI *) (* RTLinker__InitRuntime (argc, argv, envp, self); *) s.cg.set_source_line (src_line); INC (src_line); s.cg.start_call_direct (run_proc, 0, Target.CGType.Void); IF Target.DefaultCall.args_left_to_right THEN s.cg.load (argc, 0, int_t, int_t); (* argc *) s.cg.pop_param (int_t); s.cg.load (argv, 0, addr_t, addr_t); (* argv *) s.cg.pop_param (addr_t); s.cg.load (envp, 0, addr_t, addr_t); (* envp *) s.cg.pop_param (addr_t); s.cg.load (self, 0, addr_t, addr_t); (* self *) s.cg.pop_param (addr_t); ELSE s.cg.load (self, 0, addr_t, addr_t); (* self *) s.cg.pop_param (addr_t); s.cg.load (envp, 0, addr_t, addr_t); (* envp *) s.cg.pop_param (addr_t); s.cg.load (argv, 0, addr_t, addr_t); (* argv *) s.cg.pop_param (addr_t); s.cg.load (argc, 0, int_t, int_t); (* argc *) s.cg.pop_param (int_t); END; s.cg.call_direct (run_proc, Target.CGType.Void); ui := s.main_units; WHILE (ui # NIL) DO s.cg.set_source_line (src_line); INC (src_line); s.cg.start_call_direct (link_proc, 0, Target.CGType.Void); s.cg.load_procedure (ui.cg_proc); s.cg.pop_param (addr_t); s.cg.call_direct (link_proc, Target.CGType.Void); ui := ui.next; END; (* RTProcess.Exit (0); *) s.cg.set_source_line (src_line); INC (src_line); s.cg.start_call_direct (exit_proc, 0, Target.CGType.Void); s.cg.load_integer (int_t, TInt.Zero); s.cg.pop_param (int_t); s.cg.call_direct (exit_proc, Target.CGType.Void); (* return 0; *) s.cg.set_source_line (src_line); INC (src_line); s.cg.load_integer (int_t, TInt.Zero); s.cg.exit_proc (int_t); s.cg.end_procedure (main); s.cg.end_unit (); END GenerateCGEntry; PROCEDUREDeclareParam (VAR s: State; nm: TEXT; tipe: Target.CGType): M3CG.Var = BEGIN RETURN s.cg.declare_param (M3ID.Add (nm), TargetMap.CG_Bytes[tipe], TargetMap.CG_Align_bytes [tipe], tipe, (*typeUID*) 0, (*in_memory*) FALSE, (*up_level*) FALSE, (*frequency*) M3CG.Always); END DeclareParam; PROCEDUREDeclareLocal (VAR s: State; nm: TEXT; tipe: Target.CGType): M3CG.Var = BEGIN RETURN s.cg.declare_local (M3ID.Add (nm), TargetMap.CG_Bytes[tipe], TargetMap.CG_Align_bytes [tipe], tipe, (*typeUID*) 0, (*in_memory*) FALSE, (*up_level*) FALSE, (*frequency*) M3CG.Always); END DeclareLocal;
PROCEDUREErr (VAR s: State; a, b, c, d: TEXT := NIL) = <*FATAL Wr.Failure, Thread.Alerted*> BEGIN IF (s.errors = NIL) THEN RETURN END; IF (a # NIL) THEN Wr.PutText (s.errors, a); END; IF (b # NIL) THEN Wr.PutText (s.errors, b); END; IF (c # NIL) THEN Wr.PutText (s.errors, c); END; IF (d # NIL) THEN Wr.PutText (s.errors, d); END; END Err; PROCEDUREOut (VAR s: State; a, b, c, d: TEXT := NIL) = <*FATAL Wr.Failure, Thread.Alerted*> BEGIN IF (a # NIL) THEN Wr.PutText (s.wr, a) END; IF (b # NIL) THEN Wr.PutText (s.wr, b) END; IF (c # NIL) THEN Wr.PutText (s.wr, c) END; IF (d # NIL) THEN Wr.PutText (s.wr, d) END; END Out; BEGIN END MxGen.