[M3devel] alloca(sizeof(jmp_buf)) changes for review
Jay K
jay.krell at cornell.edu
Thu Aug 6 10:46:23 CEST 2015
Any objections? criticisms? suggestions?I'd like to commit this.
My bootstrapping procedure (boot1.py) precludes cm3 incompatible with m3core/libm3 -- so this is holding up moving to 10.10.4, unless I do some git gyrations.
Bootstrapping really needs to produce the matching m3core and libm3, so target can have older/newer source.
Thank you, - Jay
From: jay.krell at cornell.edu
To: m3devel at elegosoft.com
Subject: alloca(sizeof(jmp_buf)) changes for review
Date: Wed, 5 Aug 2015 09:15:22 +0000
Here are my changes for "alloca(sizeof(jmp_buf))".
NOTE: I updated 3 of the 4 backends, and tested one of them so far.I can test the other two.
NOTE: The update procedure is the same as usual, and very important, given the change to M3RT/m3-libs/m3core/src/runtime/ex_frame/RTExFrame.m3. The compiler output is closedly tied to m3core.
NOTE: This uses alloca even for the C backend. I expect to do better later.
NOTE: The real value here is the deletion of all the target-dependent linesin m3-sys/m3middle/src/Target.m3.
diff --git a/m3-libs/m3core/src/C/Common/Csetjmp.i3 b/m3-libs/m3core/src/C/Common/Csetjmp.i3index bd75beb..df2f139 100755--- a/m3-libs/m3core/src/C/Common/Csetjmp.i3+++ b/m3-libs/m3core/src/C/Common/Csetjmp.i3@@ -5,11 +5,22 @@ UNSAFE INTERFACE Csetjmp; FROM Ctypes IMPORT int; -(* jmp_buf is allocated with alloca(Csetjmp__Jumpbuf_size)+(* TODO? Move this to C?+ "u" in "ulongjmp" is probably for "underscore". This variant of longjmp never restores the signal mask.+ Because we believe we never change it?+ And restoring it is less efficient? (Requires possible kernel+ interaction?)++ If the platform only has "regular" longjmp and no signal mask,+ e.g. Win32, then this is resolved to that.+ + This function does not return in the usual sense.+ This is used to raise an exception.+ This is subject to be removed, either by using C, or "libunwind", or+ Win32 exceptions, or C++ exceptions. *)-<*EXTERNAL "Csetjmp__Jumpbuf_size" *> VAR Jumpbuf_size: INTEGER; <*EXTERNAL "Csetjmp__ulongjmp" *> PROCEDURE ulongjmp (env: ADDRESS; val: int); END Csetjmp.diff --git a/m3-libs/m3core/src/m3core.h b/m3-libs/m3core/src/m3core.hindex 37a9862..4be9ac3 100644--- a/m3-libs/m3core/src/m3core.h+++ b/m3-libs/m3core/src/m3core.h@@ -358,7 +358,9 @@ extern "C" { /* WORD_T/INTEGER are always exactly the same size as a pointer. * VMS sometimes has 32bit size_t/ptrdiff_t but 64bit pointers. */-#if defined(_WIN64) || __INITIAL_POINTER_SIZE == 64 || defined(__LP64__) || defined(_LP64)+/* commented out is correct, but so is the #else */+/*#if defined(_WIN64) || __INITIAL_POINTER_SIZE == 64 || defined(__LP64__) || defined(_LP64)*/+#if __INITIAL_POINTER_SIZE == 64 typedef INT64 INTEGER; typedef UINT64 WORD_T; #elsediff --git a/m3-libs/m3core/src/runtime/ex_frame/RTExFrame.m3 b/m3-libs/m3core/src/runtime/ex_frame/RTExFrame.m3index 6ec33fc..423a835 100644--- a/m3-libs/m3core/src/runtime/ex_frame/RTExFrame.m3+++ b/m3-libs/m3core/src/runtime/ex_frame/RTExFrame.m3@@ -36,7 +36,7 @@ TYPE (* Except, ExceptElse, Finally *) class : INTEGER; (* ORD(ScopeKind) *) handles : ExceptionList; (* NIL-terminated list of exceptions handled *) info : RT0.RaiseActivation; (* current exception being dispatched *)- jmpbuf : ARRAY [0..16_FFFF] OF LONGREAL; (* gigantic, size is not used *)+ jmpbuf : ADDRESS; (* allocated with alloca *) END; TYPE (* FinallyProc *)@@ -172,7 +172,7 @@ PROCEDURE InvokeHandler (f: Frame; READONLY a: RT0.RaiseActivation) RAISES ANY END; RTThread.SetCurrentHandlers (f.next); (* cut to the new handler *) p.info := a; (* copy the exception to the new frame *)- Csetjmp.ulongjmp (ADR(p.jmpbuf), 1); (* and jump... *)+ Csetjmp.ulongjmp (p.jmpbuf, 1); (* and jump... *) RAISE OUCH; END InvokeHandler; diff --git a/m3-libs/m3core/src/unix/Common/Uconstants.c b/m3-libs/m3core/src/unix/Common/Uconstants.cindex 99b1adf..84095c1 100644--- a/m3-libs/m3core/src/unix/Common/Uconstants.c+++ b/m3-libs/m3core/src/unix/Common/Uconstants.c@@ -46,7 +46,7 @@ typedef int CheckMax[248 - sizeof(CheckMax_t)]; #include "UerrorX.h" /* This needs to be aligned to 16, at least for Win32. */-EXTERN_CONST INTEGER Csetjmp__Jumpbuf_size = ((sizeof(jmp_buf) + 15) & ~15);+EXTERN_CONST INTEGER m3_jmpbuf_size = ((sizeof(jmp_buf) + 15) & ~15); #ifndef _WIN32 diff --git a/m3-sys/cminstall/src/config-no-install/Darwin.common b/m3-sys/cminstall/src/config-no-install/Darwin.commonindex 0bf3e7e..7043383 100644 diff --git a/m3-sys/m3back/src/M3C.m3 b/m3-sys/m3back/src/M3C.m3index 82285e9..ab858b0 100644--- a/m3-sys/m3back/src/M3C.m3+++ b/m3-sys/m3back/src/M3C.m3@@ -66,7 +66,7 @@ T = M3CG_DoNothing.T BRANDED "M3C.T" OBJECT Err : ErrorHandler := DefaultErrorHandler; anonymousCounter := -1; c : Wr.T := NIL;- debug := 0; (* or 0, 1, 2, 3, 4 *)+ debug := 1; (* 1-4 *) stack : RefSeq.T := NIL; params : TextSeq.T := NIL; op_index := 0;@@ -80,6 +80,10 @@ T = M3CG_DoNothing.T BRANDED "M3C.T" OBJECT RTHooks_Raise_id: M3ID.T := 0; RTHooks_ReportFault_id: M3ID.T := 0; RTHooks_ReportFault_imported_or_declared := FALSE;+ alloca_id : M3ID.T := 0;+ setjmp_id : M3ID.T := 0;+ u_setjmp_id : M3ID.T := 0;+ longjmp_id : M3ID.T := 0; (* labels *) labels_min := FIRST(Label);@@ -1679,6 +1683,7 @@ TYPE Proc_t = M3CG.Proc OBJECT uplevels := FALSE; is_exception_handler := FALSE; is_RTHooks_Raise := FALSE;+ omit_prototype := FALSE; is_RTException_Raise := FALSE; no_return := FALSE; exit_proc_skipped := 0;@@ -1752,23 +1757,45 @@ BEGIN END IsNameExceptionHandler; PROCEDURE Proc_Init(proc: Proc_t; self: T): Proc_t =-VAR is_common := (proc.parent = NIL- AND (proc.exported = TRUE OR proc.imported = TRUE)- AND proc.level = 0- AND proc.return_type = CGType.Void);- is_RTHooks_ReportFault := (is_common- AND proc.name = self.RTHooks_ReportFault_id- AND proc.parameter_count = 2);- is_RTHooks_AssertFailed := (is_common- AND proc.name = self.RTHooks_AssertFailed_id- AND proc.parameter_count = 3);-BEGIN- proc.is_RTHooks_Raise := (is_common- AND proc.name = self.RTHooks_Raise_id- AND proc.parameter_count = 4);- proc.is_RTException_Raise := (is_common- AND proc.name = self.RTException_Raise_id- AND proc.parameter_count = 1);+VAR name := proc.name;+ parameter_count := proc.parameter_count;+ is_common := proc.parent = NIL+ AND (proc.exported = TRUE OR proc.imported = TRUE)+ AND proc.level = 0;+ is_common_void := is_common AND proc.return_type = CGType.Void;+ is_RTHooks_ReportFault := is_common_void+ AND name = self.RTHooks_ReportFault_id+ AND parameter_count = 2;+ is_RTHooks_AssertFailed := is_common_void+ AND name = self.RTHooks_AssertFailed_id+ AND parameter_count = 3;+BEGIN+ (* Omit a few prototypes that the frontend might have slightly wrong,+ e.g. alloca(unsigned int vs. unsigned long vs. unsigned long long)+ vs. not a function.+ e.g. setjmp(void* ) vs. setjmp(array)+ *)+ proc.omit_prototype := is_common+ AND parameter_count = 1 (* TODO 2 for longjmp *)+ AND (name = self.alloca_id+ (* TODO+ - add CGType.Jmpbuf+ - #include <setjmp.h> if there are any+ calls to setjmp/_setjmp/longjmp+ or instances of CGType.Jmpbuf+ - render CGType.Jmpbuf as "jmp_buf"+ - omit setjmp/_setjmp/longjmp prototypes+ OR name = self.setjmp_id+ OR name = self.u_setjmp_id+ OR name = self.longjmp_id+ *)+ );+ proc.is_RTHooks_Raise := is_common_void+ AND name = self.RTHooks_Raise_id+ AND parameter_count = 4;+ proc.is_RTException_Raise := is_common_void+ AND name = self.RTException_Raise_id+ AND parameter_count = 1; IF is_RTHooks_ReportFault THEN self.RTHooks_ReportFault_imported_or_declared := TRUE; END;@@ -1777,9 +1804,10 @@ BEGIN no_return(self); END; proc.self := self;- proc.name := Proc_FixName(proc.self, proc.name);- proc.is_exception_handler := proc.level > 0 AND proc.parameter_count = 1 AND IsNameExceptionHandler(self, NameT(proc.name));- proc.parameter_count_without_static_link := proc.parameter_count;+ proc.name := Proc_FixName(proc.self, name);+ name := proc.name;+ proc.is_exception_handler := proc.level > 0 AND parameter_count = 1 AND IsNameExceptionHandler(self, NameT(name));+ proc.parameter_count_without_static_link := parameter_count; proc.add_static_link := proc.level > 0; INC(proc.parameter_count, ORD(proc.add_static_link)); proc.locals := NEW(RefSeq.T).init();@@ -1865,8 +1893,10 @@ CONST Prefix = ARRAY OF TEXT { "#pragma warning(disable:4255) /* () change to (void) */", "#pragma warning(disable:4668) /* #if of undefined symbol */", "#endif",-"typedef char* ADDRESS;", (* TODO remove this when we finish strong typing *)-"typedef char* STRUCT;", (* TODO remove this when we finish strong typing *)+(* TODO ideally these are char* for K&R or ideally absent when strong+ typing and setjmp work done *)+"typedef char* ADDRESS;",+"typedef char* STRUCT;", "typedef signed char INT8;", "typedef unsigned char UINT8;", "typedef short INT16;",@@ -1907,6 +1937,8 @@ CONST Prefix = ARRAY OF TEXT { "#include <stddef.h>", (* try to remove this, it is slow -- need size_t *) "#endif", +(* "#include <setjmp.h>", TODO do not always #include *)+ "/* http://c.knowcoding.com/view/23699-portable-alloca.html */", "/* Find a good version of alloca. */", "#ifndef alloca",@@ -1946,7 +1978,7 @@ CONST Prefix = ARRAY OF TEXT { "#define STRUCT1(n) typedef struct { volatile char a[n]; } STRUCT(n);", (* TODO prune if not used *) "#define STRUCT2(n) typedef struct { volatile short a[n/2]; } STRUCT(n);", (* TODO prune if not used *) "#define STRUCT4(n) typedef struct { volatile int a[n/4]; } STRUCT(n);", (* TODO prune if not used *)-"#define STRUCT8(n) typedef struct { volatile double a[n/8]; } STRUCT(n);", (* TODO prune if not used *)+"#define STRUCT8(n) typedef struct { volatile UINT64 a[n/8]; } STRUCT(n);", (* TODO prune if not used *) "#ifdef __cplusplus", "#define DOTDOTDOT ...", "#else",@@ -2285,6 +2317,10 @@ BEGIN self.comment("M3_TARGET = ", Target.System_name); self.comment("M3_WORDSIZE = ", IntToDec(Target.Word.size)); self.static_link_id := M3ID.Add("_static_link");+ self.alloca_id := M3ID.Add("alloca");+ self.setjmp_id := M3ID.Add("setjmp");+ self.u_setjmp_id := M3ID.Add("_setjmp"); (* "u" is for underscore *)+ self.longjmp_id := M3ID.Add("longjmp"); self.RTHooks_ReportFault_id := M3ID.Add("RTHooks__ReportFault"); self.RTHooks_Raise_id := M3ID.Add("RTHooks__Raise"); self.RTException_Raise_id := M3ID.Add("RTException__Raise");@@ -3555,6 +3591,7 @@ BEGIN HelperFunctions_helper_with_type_and_array(self, op, type, types, ARRAY OF TEXT{first}); END HelperFunctions_helper_with_type; +(* TODO give up and #include <string.h>? *) PROCEDURE HelperFunctions_memset(self: HelperFunctions_t) = CONST text = "void* __cdecl memset(void*, int, size_t); /* string.h */"; BEGIN@@ -4270,6 +4307,9 @@ VAR params := proc.params; define_kr := NOT ansi AND kind = FunctionPrototype_t.Define; kr_part2 := ""; BEGIN+ IF proc.omit_prototype THEN+ RETURN "";+ END; IF NUMBER (params^) = 0 THEN text := text & "(void)"; ELSIF NOT ansi AND NOT define_kr THENdiff --git a/m3-sys/m3back/src/M3x86.m3 b/m3-sys/m3back/src/M3x86.m3index 206f9fb..2fff809 100644--- a/m3-sys/m3back/src/M3x86.m3+++ b/m3-sys/m3back/src/M3x86.m3@@ -3283,7 +3283,7 @@ CONST BP { "m3_rotate_right64",3, Type.Word64, Target.STDCALL }, BP { "m3_rotate64", 3, Type.Word64, Target.STDCALL }, - BP { "m3_alloca", 0, Type.Addr, Target.CDECL, "__chkstk", EAX }+ BP { "alloca", 0, Type.Addr, Target.CDECL, "__chkstk", EAX } }; PROCEDURE start_int_proc (u: U; b: Builtin) =diff --git a/m3-sys/m3cc/gcc/gcc/m3cg/parse.c b/m3-sys/m3cc/gcc/gcc/m3cg/parse.cindex d965c8a..fdbbdf4 100644--- a/m3-sys/m3cc/gcc/gcc/m3cg/parse.c+++ b/m3-sys/m3cc/gcc/gcc/m3cg/parse.c@@ -643,7 +643,7 @@ static GTY (()) tree t_int; #define t_void void_type_node static GTY (()) tree t_set; -static tree m3_alloca;+static tree alloca_tree; static const struct { UINT32 type_id; tree* t; } builtin_uids[] = { { UID_INTEGER, &t_int },@@ -1914,7 +1914,7 @@ m3_init_decl_processing (void) bits_per_integer_tree = build_int_cst (t_word, BITS_PER_INTEGER); bytes_per_integer_tree = build_int_cst (t_word, BITS_PER_INTEGER / BITS_PER_UNIT); tree stdcall = get_identifier_with_length (CONSTANT_STRING_AND_LENGTH ("stdcall"));- m3_alloca = get_identifier_with_length (CONSTANT_STRING_AND_LENGTH ("m3_alloca"));+ alloca_tree = get_identifier_with_length (CONSTANT_STRING_AND_LENGTH ("alloca")); stdcall_list = build_tree_list (stdcall, NULL); t_set = m3_build_pointer_type (t_word); @@ -3076,7 +3076,7 @@ fix_name (PCSTR name, size_t length, UINT32 type_id) } else if (type_id == NO_UID) {- buf = (PSTR)alloca (sizet_add(length, 1));+ buf = (PSTR)alloca (sizet_add (length, 1)); buf[0] = 'M'; memcpy (&buf[1], name, length); length += 1;@@ -3153,7 +3153,8 @@ m3_pop_param (tree type) static tree m3_convert_function_to_builtin (tree p) {- if (DECL_NAME (p) == m3_alloca)+ tree name = DECL_NAME (p);+ if (name == alloca_tree) p = builtin_decl_explicit (BUILT_IN_ALLOCA); return p; }diff --git a/m3-sys/m3front/src/misc/M3.i3 b/m3-sys/m3front/src/misc/M3.i3index ec7f972..4a3793e 100644--- a/m3-sys/m3front/src/misc/M3.i3+++ b/m3-sys/m3front/src/misc/M3.i3@@ -11,7 +11,7 @@ INTERFACE M3; -IMPORT M3ID, M3Buf;+IMPORT M3ID, M3Buf, Jmpbufs; TYPE Flag = BITS 1 FOR BOOLEAN;@@ -33,6 +33,7 @@ TYPE ExSet <: Node; (* == ESet.T *) ExSetList <: REFANY; (* == list of ExSet *) EqAssumption <: ADDRESS; (* == Type.Assumption *)+ Procedure <: Value; (* == Procedure.T *) (*--------------------------------------------------------- type checking ---*) @@ -41,13 +42,15 @@ TYPE (* the "global state" that is passed around during type checking *) raises_others : BOOLEAN; ok_to_raise : ExSetList; no_error : ExSetList;+ jmpbufs := Jmpbufs.CheckState { }; END; CONST OuterCheckState = CheckState { raises_others := FALSE, ok_to_raise := NIL,- no_error := NIL+ no_error := NIL,+ jmpbufs := Jmpbufs.CheckState { } }; (*-------------------------------------------------------- fingerprinting ---*)diff --git a/m3-sys/m3front/src/misc/Marker.i3 b/m3-sys/m3front/src/misc/Marker.i3index db880a0..8d8f044 100644--- a/m3-sys/m3front/src/misc/Marker.i3+++ b/m3-sys/m3front/src/misc/Marker.i3@@ -64,8 +64,9 @@ PROCEDURE PopFrame (frame: CG.Var); PROCEDURE SetLock (acquire: BOOLEAN; var: CG.Var; offset: INTEGER); (* generate the call to acquire or release a mutex *) -PROCEDURE CaptureState (frame: CG.Var; handler: CG.Label);-(* call 'setjmp' on 'frame's jmpbuf and branch to 'handler' on re-returns. *)+PROCEDURE CaptureState (frame: CG.Var; jmpbuf: CG.Var; handler: CG.Label);+(* frame.jmpbuf = jmpbuf+ if (setjmp(jmpbuf)) goto handler *) PROCEDURE Reset (); diff --git a/m3-sys/m3front/src/misc/Marker.m3 b/m3-sys/m3front/src/misc/Marker.m3index 6512fbb..9421b7c 100644--- a/m3-sys/m3front/src/misc/Marker.m3+++ b/m3-sys/m3front/src/misc/Marker.m3@@ -53,9 +53,6 @@ VAR all_frames : FramePtr := NIL; n_frames : INTEGER := 0; save_depth : INTEGER := 0;- setjmp : CG.Proc := NIL;- alloca : CG.Proc := NIL;- Jumpbuf_size : CG.Var := NIL; tos : INTEGER := 0; stack : ARRAY [0..50] OF Frame; @@ -231,68 +228,13 @@ PROCEDURE CallFinallyHandler (info: CG.Var; END; END CallFinallyHandler; -PROCEDURE CaptureState (frame: CG.Var; handler: CG.Label) =- CONST Alloca_jmpbuf = FALSE;- VAR new: BOOLEAN;- label_already_allocated: CG.Label;- BEGIN- (* int setjmp(void* ); *)- IF setjmp = NIL THEN- setjmp := CG.Import_procedure (M3ID.Add (Target.Setjmp), 1,- Target.Integer.cg_type,- Target.DefaultCall, new);- IF (new) THEN- EVAL CG.Declare_param (M3ID.Add ("jmpbuf"), Target.Address.size,- Target.Address.align, CG.Type.Addr, 0,- in_memory := FALSE, up_level := FALSE,- f := CG.Never);- END;- END;- - IF Alloca_jmpbuf THEN- label_already_allocated := CG.Next_label ();-- (* void* _alloca(size_t); *)- IF alloca = NIL THEN- alloca := CG.Import_procedure (M3ID.Add ("m3_alloca"), 1, CG.Type.Addr,- Target.DefaultCall, new);- IF new THEN- EVAL CG.Declare_param (M3ID.NoID, Target.Word.size, Target.Word.align,- Target.Word.cg_type, 0, in_memory := FALSE,- up_level := FALSE, f := CG.Never);- END;- END;- (* extern /*const*/ size_t Csetjmp__Jumpbuf_size/* = sizeof(jmp_buf)*/; *)- IF Jumpbuf_size = NIL THEN- Jumpbuf_size := CG.Import_global (M3ID.Add ("Csetjmp__Jumpbuf_size"),- Target.Word.size, Target.Word.align,- Target.Word.cg_type, 0);- END;- - (* if (!frame.jmpbuf)- frame.jmpbuf = alloca(Csetjmp__Jumpbuf_size);- *)- CG.Load_addr (frame, M3RT.EF1_jmpbuf);- CG.Load_nil ();- CG.If_compare (Target.Address.cg_type, CG.Cmp.NE, label_already_allocated, CG.Likely);-- CG.Start_call_direct (alloca, 0, Target.Address.cg_type);- CG.Load_int (Target.Word.cg_type, Jumpbuf_size);- CG.Pop_param (Target.Word.cg_type);- CG.Call_direct (alloca, Target.Address.cg_type);- CG.Check_nil (CG.RuntimeError.BadMemoryReference);- CG.Store_addr (frame, M3RT.EF1_jmpbuf);-- CG.Set_label (label_already_allocated);- END;-- (* setjmp(frame.jmpbuf) or setjmp(&frame.jmpbuf) *)+PROCEDURE CaptureState (frame: CG.Var; jmpbuf: CG.Var; handler: CG.Label) =+ VAR setjmp := Module.GetSetjmp (Module.Current ());+ BEGIN+ CG.Load_addr (jmpbuf);+ CG.Store_addr (frame, M3RT.EF1_jmpbuf); CG.Start_call_direct (setjmp, 0, Target.Integer.cg_type);- IF Alloca_jmpbuf THEN- CG.Load_addr (frame, M3RT.EF1_jmpbuf);- ELSE- CG.Load_addr_of (frame, M3RT.EF1_jmpbuf, 128);- END;+ CG.Load_addr (jmpbuf); CG.Pop_param (CG.Type.Addr); CG.Call_direct (setjmp, Target.Integer.cg_type); CG.If_true (handler, CG.Never);@@ -820,9 +762,6 @@ PROCEDURE Reset () = all_frames := NIL; n_frames := 0; save_depth := 0;- setjmp := NIL;- alloca := NIL;- Jumpbuf_size := NIL; tos := 0; END Reset; diff --git a/m3-sys/m3front/src/misc/m3makefile b/m3-sys/m3front/src/misc/m3makefileindex 721cc27..7d5fba3 100644--- a/m3-sys/m3front/src/misc/m3makefile+++ b/m3-sys/m3front/src/misc/m3makefile@@ -16,6 +16,7 @@ module ("M3WString") module ("Token") module ("Error") module ("Host")+module ("Jmpbufs") module ("Marker") module ("Scanner") module ("Scope")diff --git a/m3-sys/m3front/src/stmts/TryFinStmt.m3 b/m3-sys/m3front/src/stmts/TryFinStmt.m3index 89233c5..e0d9b33 100644--- a/m3-sys/m3front/src/stmts/TryFinStmt.m3+++ b/m3-sys/m3front/src/stmts/TryFinStmt.m3@@ -10,6 +10,7 @@ MODULE TryFinStmt; IMPORT M3ID, CG, Token, Scanner, Stmt, StmtRep, Marker, Target, Type, Addr; IMPORT RunTyme, Procedure, ProcBody, M3RT, Scope, Fmt, Host, TryStmt, Module;+IMPORT Jmpbufs; FROM Stmt IMPORT Outcome; TYPE@@ -20,6 +21,7 @@ TYPE viaProc : BOOLEAN; scope : Scope.T; handler : HandlerProc;+ jmpbufs : Jmpbufs.Try; OVERRIDES check := Check; compile := Compile;@@ -30,6 +32,7 @@ TYPE HandlerProc = ProcBody.T OBJECT self: P; activation: CG.Var;+ jmpbufs : Jmpbufs.Proc; OVERRIDES gen_decl := EmitDecl; gen_body := EmitBody;@@ -66,6 +69,7 @@ PROCEDURE Parse (body: Stmt.T; ): Stmt.T = PROCEDURE Check (p: P; VAR cs: Stmt.CheckState) = VAR zz: Scope.T; oc: Stmt.Outcomes; name: INTEGER; BEGIN+ Jmpbufs.CheckTry (cs.jmpbufs, p.jmpbufs); Marker.PushFinally (CG.No_label, CG.No_label, NIL); Stmt.TypeCheck (p.body, cs); Marker.Pop ();@@ -89,8 +93,11 @@ PROCEDURE Check (p: P; VAR cs: Stmt.CheckState) = next_uid := 0; END; zz := Scope.Push (p.scope);+ p.handler.jmpbufs := Jmpbufs.CheckProcPush (cs.jmpbufs,+ M3ID.Add (p.handler.name)); Scope.TypeCheck (p.scope, cs); Stmt.TypeCheck (p.finally, cs);+ Jmpbufs.CheckProcPop (cs.jmpbufs, p.handler.jmpbufs); Scope.Pop (zz); END; END;@@ -226,6 +233,7 @@ PROCEDURE Compile2 (p: P): Stmt.Outcomes = CG.Gen_location (p.forigin); IF (Host.inline_nested_procs) THEN CG.Begin_procedure (p.handler.cg_proc);+ Jmpbufs.CompileProcAllocateJmpbufs (p.handler.jmpbufs); xc := Stmt.Compile (p.finally); CG.Exit_proc (CG.Type.Void); CG.End_procedure (p.handler.cg_proc);@@ -272,6 +280,7 @@ PROCEDURE EmitBody (x: HandlerProc) = Scanner.offset := p.forigin; CG.Gen_location (p.forigin); CG.Begin_procedure (x.cg_proc);+ Jmpbufs.CompileProcAllocateJmpbufs (x.jmpbufs); EVAL Stmt.Compile (p.finally); CG.Exit_proc (CG.Type.Void); CG.End_procedure (x.cg_proc);@@ -302,7 +311,7 @@ PROCEDURE Compile3 (p: P): Stmt.Outcomes = l := CG.Next_label (3); CG.Set_label (l, barrier := TRUE); Marker.PushFrame (frame, M3RT.HandlerClass.Finally);- Marker.CaptureState (frame, l+1);+ Marker.CaptureState (frame, Jmpbufs.CompileTryGetJmpbuf (p.jmpbufs), l+1); (* compile the body *) Marker.PushFinally (l, l+1, frame);diff --git a/m3-sys/m3front/src/stmts/TryStmt.m3 b/m3-sys/m3front/src/stmts/TryStmt.m3index 8e7a308..a81e0da 100644--- a/m3-sys/m3front/src/stmts/TryStmt.m3+++ b/m3-sys/m3front/src/stmts/TryStmt.m3@@ -10,7 +10,7 @@ MODULE TryStmt; IMPORT M3, M3ID, CG, Variable, Scope, Exceptionz, Value, Error, Marker; IMPORT Type, Stmt, StmtRep, TryFinStmt, Token;-IMPORT Scanner, ESet, Target, M3RT, Tracer;+IMPORT Scanner, ESet, Target, M3RT, Tracer, Jmpbufs; FROM Scanner IMPORT Match, MatchID, GetToken, Fail, cur; TYPE@@ -22,6 +22,7 @@ TYPE hasElse : BOOLEAN; elseBody : Stmt.T; handled : ESet.T;+ jmpbufs : Jmpbufs.Try; OVERRIDES check := Check; compile := Compile;@@ -162,6 +163,7 @@ PROCEDURE ReverseHandlers (p: P) = PROCEDURE Check (p: P; VAR cs: Stmt.CheckState) = VAR h: Handler; handled: ESet.T; BEGIN+ Jmpbufs.CheckTry (cs.jmpbufs, p.jmpbufs); h := p.handles; WHILE (h # NIL) DO CheckLabels (h, p.scope, cs); h := h.next; END; @@ -429,7 +431,7 @@ PROCEDURE Compile2 (p: P): Stmt.Outcomes = END; (* capture the machine state *)- Marker.CaptureState (frame, l+1);+ Marker.CaptureState (frame, Jmpbufs.CompileTryGetJmpbuf (p.jmpbufs), l+1); (* compile the body *) oc := Stmt.Compile (p.body);diff --git a/m3-sys/m3front/src/values/Module.i3 b/m3-sys/m3front/src/values/Module.i3index 58fa9bd..3935126 100644--- a/m3-sys/m3front/src/values/Module.i3+++ b/m3-sys/m3front/src/values/Module.i3@@ -72,4 +72,13 @@ PROCEDURE Reset (); PROCEDURE MakeCurrent (t: T); (* refresh 't' and its imports for the current compilation *) +(* Exception handling support, using setjmp/longjmp, w/o front/middle-end+ knowing jmpbuf size -- use alloca at runtime getting size from+ constant initialized in C; these functions are in Module+ to accomodate hypothetical multi-threaded m3front,+ i.e. instead of having globals initialized on-demand in Jmpbufs. *)+PROCEDURE GetAlloca (t: T) : CG.Proc;+PROCEDURE GetJmpbufSize (t: T): CG.Var;+PROCEDURE GetSetjmp (t: T) : CG.Proc;+ END Module.diff --git a/m3-sys/m3front/src/values/Module.m3 b/m3-sys/m3front/src/values/Module.m3index 336b0f2..b587639 100644--- a/m3-sys/m3front/src/values/Module.m3+++ b/m3-sys/m3front/src/values/Module.m3@@ -12,7 +12,7 @@ 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, Wr;-IMPORT WCharr; +IMPORT WCharr, Jmpbufs; FROM Scanner IMPORT GetToken, Fail, Match, MatchID, cur; @@ -50,6 +50,10 @@ REVEAL value_info : Value.T; lazyAligned : BOOLEAN; containsLazyAlignments: BOOLEAN;+ jmpbuf_size : CG.Var := NIL;+ alloca : CG.Proc := NIL;+ setjmp : CG.Proc := NIL;+ jmpbufs : Jmpbufs.Proc; OVERRIDES typeCheck := TypeCheckMethod; set_globals := ValueRep.NoInit;@@ -109,6 +113,61 @@ PROCEDURE Reset () = INC (compile_age); END Reset; +PROCEDURE GetAlloca (t: T) : CG.Proc =+VAR new := FALSE;+BEGIN+ (* alloca must be special cased by backends to mean+ alloca, _alloca, chkstk, etc. *)+ IF t.alloca = NIL THEN+ t.alloca := CG.Import_procedure (M3ID.Add ("alloca"), 1, CG.Type.Addr,+ Target.DefaultCall, new);+ IF new THEN+ EVAL CG.Declare_param (M3ID.NoID, Target.Word.size, Target.Word.align,+ Target.Word.cg_type, 0, in_memory := FALSE,+ up_level := FALSE, f := CG.Never);+ END;+ END;+ RETURN t.alloca;+END GetAlloca;+++PROCEDURE GetJmpbufSize (t: T): CG.Var =+BEGIN+ (* m3_jmpbuf_size is a "constant variable" initialized in + C via:+ #include <setjmp.h>+ extern const m3_jmpbuf_size = sizeof(jmp_buf);+ As an optimization, and to avoid any matters involving dynamically+ importing data on Win32, Uconstants is always statically linked.+ + This isolates the front/middle end from the target.+ *)+ IF t.jmpbuf_size = NIL THEN+ t.jmpbuf_size := CG.Import_global (M3ID.Add ("m3_jmpbuf_size"),+ Target.Word.size, Target.Word.align,+ Target.Word.cg_type, 0);+ END;+ RETURN t.jmpbuf_size;+END GetJmpbufSize;++PROCEDURE GetSetjmp (t: T): CG.Proc =+VAR new := FALSE;+BEGIN+ (* int setjmp(void* ); *)+ IF t.setjmp = NIL THEN+ t.setjmp := CG.Import_procedure (M3ID.Add (Target.Setjmp), 1,+ Target.Integer.cg_type,+ Target.DefaultCall, new);+ IF new THEN+ EVAL CG.Declare_param (M3ID.Add ("jmpbuf"), Target.Address.size,+ Target.Address.align, CG.Type.Addr, 0,+ in_memory := FALSE, up_level := FALSE,+ f := CG.Never);+ END;+ END;+ RETURN t.setjmp;+END GetSetjmp;+ PROCEDURE Create (name: M3ID.T): T = VAR t: T; BEGIN@@ -592,8 +651,10 @@ PROCEDURE TypeCheck (t: T; main: BOOLEAN; VAR cs: Value.CheckState) = Revelation.TypeCheck (t.revelations); Scope.TypeCheck (t.localScope, cs); IF (NOT t.interface) THEN+ t.jmpbufs := Jmpbufs.CheckProcPush (cs.jmpbufs, 0); BlockStmt.CheckTrace (t.trace, cs); Stmt.TypeCheck (t.block, cs);+ Jmpbufs.CheckProcPop (cs.jmpbufs, t.jmpbufs); END; ESet.Pop (cs, NIL, t.fails, stop := TRUE);@@ -1041,6 +1102,7 @@ PROCEDURE EmitBody (x: InitBody) = (* perform the main body *) Tracer.Push (t.trace);+ Jmpbufs.CompileProcAllocateJmpbufs (t.jmpbufs); EVAL Stmt.Compile (t.block); Tracer.Pop (t.trace); diff --git a/m3-sys/m3front/src/values/Procedure.i3 b/m3-sys/m3front/src/values/Procedure.i3index dddb1f3..114a3ec 100644--- a/m3-sys/m3front/src/values/Procedure.i3+++ b/m3-sys/m3front/src/values/Procedure.i3@@ -8,9 +8,9 @@ INTERFACE Procedure; -IMPORT CG, Value, Type, CallExpr, Decl;+IMPORT CG, Value, Type, CallExpr, Decl, M3; -TYPE T <: Value.T;+TYPE T = M3.Procedure; (* <: Value.T *) PROCEDURE ParseDecl (READONLY att: Decl.Attributes; headerOnly: BOOLEAN := FALSE);diff --git a/m3-sys/m3front/src/values/Procedure.m3 b/m3-sys/m3front/src/values/Procedure.m3index ad0d39c..39df85b 100644--- a/m3-sys/m3front/src/values/Procedure.m3+++ b/m3-sys/m3front/src/values/Procedure.m3@@ -12,7 +12,7 @@ MODULE Procedure; IMPORT M3, M3ID, CG, Value, ValueRep, Type, Scope, Error, Host; IMPORT ProcType, Stmt, BlockStmt, Marker, Coverage, M3RT; IMPORT CallExpr, Token, Variable, ProcExpr, Tracer;-IMPORT Scanner, Decl, ESet, ProcBody, Target, Expr, Formal;+IMPORT Scanner, Decl, ESet, ProcBody, Target, Expr, Formal, Jmpbufs; FROM Scanner IMPORT GetToken, Match, MatchID, cur; REVEAL@@ -33,6 +33,7 @@ REVEAL cg_proc : CG.Proc; next_cg_proc : T; end_origin : INTEGER;+ jmpbufs : Jmpbufs.Proc; OVERRIDES typeCheck := Check; set_globals := ValueRep.NoInit;@@ -307,7 +308,9 @@ PROCEDURE CheckBody (p: T; VAR cs: Value.CheckState) = INC (Type.recursionDepth); Scope.TypeCheck (p.syms, cs); Marker.PushProcedure (result, p.result, cconv);+ p.jmpbufs := Jmpbufs.CheckProcPush (cs.jmpbufs, p.name); Stmt.TypeCheck (p.block, cs);+ Jmpbufs.CheckProcPop (cs.jmpbufs, p.jmpbufs); Marker.Pop (); Scope.WarnUnused (p.syms); DEC (Type.recursionDepth);@@ -574,6 +577,7 @@ PROCEDURE GenBody (p: T) = Scope.InitValues (p.syms); Scanner.offset := BlockStmt.BodyOffset (p.block); Coverage.CountProcedure (p);+ Jmpbufs.CompileProcAllocateJmpbufs (p.jmpbufs); oc := Stmt.Compile (p.block); fallThru := (Stmt.Outcome.FallThrough IN oc); EndRaises (p, l, frame, fallThru);diff --git a/m3-sys/m3middle/src/M3RT.m3 b/m3-sys/m3middle/src/M3RT.m3index 058cea3..463860c 100644--- a/m3-sys/m3middle/src/M3RT.m3+++ b/m3-sys/m3middle/src/M3RT.m3@@ -10,9 +10,9 @@ IMPORT Target; PROCEDURE Init () = VAR- IP := Target.Integer.pack;- AP := Target.Address.pack;- CP := Target.Char.pack;+ IP := Target.Integer.pack; (* 32 or 64, same as Target.Address.pack *)+ AP := Target.Address.pack; (* 32 or 64, same as Target.Integer.pack *)+ CP := Target.Char.pack; (* 8 *) BEGIN (* closure offsets *) CL_marker := 0; (* : INTEGER *)@@ -57,8 +57,8 @@ PROCEDURE Init () = (* Except, ExceptElse, and Finally frames *) EF1_handles := EF_SIZE; (* : ADDRESS *) EF1_info := EF1_handles + AP; (* : RTException.Activation *)- EF1_jmpbuf := RoundUp (EF1_info + EA_SIZE, 128); (* : jmp_buf *)- EF1_SIZE := EF1_jmpbuf + Target.Jumpbuf_size;+ EF1_jmpbuf := EF1_info + EA_SIZE; (* : jmp_buf *)+ EF1_SIZE := EF1_jmpbuf + AP; (* FinallyProc frames *) EF2_handler := EF_SIZE; (* : ADDRESS (PROC) *)@@ -149,10 +149,5 @@ PROCEDURE Init () = MUTEX_release := 1 * AP; (*: PROC() *) END Init; -PROCEDURE RoundUp (a, b: INTEGER): INTEGER =- BEGIN- RETURN (a + b - 1) DIV b * b;- END RoundUp;- BEGIN END M3RT.diff --git a/m3-sys/m3middle/src/Target.i3 b/m3-sys/m3middle/src/Target.i3index c0e5c4c..bd27a07 100644--- a/m3-sys/m3middle/src/Target.i3+++ b/m3-sys/m3middle/src/Target.i3@@ -386,9 +386,6 @@ VAR (*CONST*) will cause an address faults. Hence, no explicit NIL checks are needed for dereferencing with offsets in this range. *) - (* Thread stacks *)- Jumpbuf_size : CARDINAL; (* size of a "jmp_buf" *)- (* floating point values *) All_floats_legal : BOOLEAN; (* If all bit patterns are "legal" floating point values (i.e. they candiff --git a/m3-sys/m3middle/src/Target.m3 b/m3-sys/m3middle/src/Target.m3index 514a75c..475422f 100644--- a/m3-sys/m3middle/src/Target.m3+++ b/m3-sys/m3middle/src/Target.m3@@ -193,132 +193,11 @@ PROCEDURE Init (system: TEXT; in_OS_name: TEXT; backend_mode: M3BackendMode_t): END; CASE System OF- - | Systems.ALPHA_LINUX => Jumpbuf_size := 34 * Address.size;- | Systems.ALPHA_OPENBSD => Jumpbuf_size := 81 * Address.size;- | Systems.ALPHA_OSF => Jumpbuf_size := 84 * Address.size;-- | Systems.I386_FREEBSD, Systems.FreeBSD4 =>- Jumpbuf_size := 11 * Address.size;-- | Systems.AMD64_NETBSD,- Systems.AMD64_OPENBSD,- Systems.AMD64_FREEBSD =>- Jumpbuf_size := 12 * Address.size;-- | Systems.ARM_LINUX,- Systems.ARMEL_LINUX =>- Jumpbuf_size := 64 * Int64.size; (* 392 bytes = 49 * Int64.size on Raspberry Pi *)-- | Systems.PA32_HPUX =>- (* 200 bytes with 8 byte alignment *)- Jumpbuf_size := 50 * Address.size;-- | Systems.PA64_HPUX =>- (* 640 bytes with 16 byte alignment *)- Jumpbuf_size := 80 * Address.size;-- | Systems.MIPS64_OPENBSD,- Systems.MIPS64EL_OPENBSD =>- Jumpbuf_size := 16_53 * Address.size;-- | Systems.I386_INTERIX =>-- (* Visual C++'s 16 plus 2 ints: is sigmask saved, its value. *)-- Jumpbuf_size := 18 * Address.size;-- | Systems.NT386, Systems.I386_NT, Systems.I386_CYGWIN, Systems.I386_MINGW =>-- (* Cygwin: 13, Visual C++: 16, Interix: 18.- Use 18 for interop.- Cygwin's setjmp.h is wrong by a factor of 4.- Cygwin provides setjmp and _setjmp that resolve the same.- Visual C++ provides only _setjmp.- Visual C++ also has _setjmp3 that the compiler generates- a call to. In fact _setjmp appears to only use 8 ints- and _setjmp3 appears to use more. Consider using _setjmp3.- *)- Jumpbuf_size := 18 * Address.size; | Systems.AMD64_NT =>- (* 256 bytes with 16 byte alignment *)- Jumpbuf_size := 32 * Int64.size; Setjmp := "setjmp"; - | Systems.IA64_FREEBSD, Systems.IA64_HPUX,- Systems.IA64_LINUX, Systems.IA64_NETBSD, Systems.IA64_NT,- Systems.IA64_OPENBSD, Systems.IA64_VMS =>- (* random guess: 1K *)- Jumpbuf_size := 128 * Address.size;-- | Systems.SPARC32_SOLARIS, Systems.SOLgnu, Systems.SOLsun =>- (* 76 bytes with 4 byte alignment *)- Jumpbuf_size := 19 * Address.size;-- | Systems.SPARC32_LINUX =>- Jumpbuf_size := 16_90 * Char.size;-- | Systems.SPARC64_OPENBSD =>- Jumpbuf_size := 14 * Address.size;-- | Systems.SPARC64_LINUX =>- Jumpbuf_size := 16_280 * Char.size;-- | Systems.SPARC64_SOLARIS =>- (* 96 bytes with 8 byte alignment *)- Jumpbuf_size := 12 * Address.size;-- | Systems.I386_SOLARIS =>- (* 40 bytes with 4 byte alignment *)- Jumpbuf_size := 10 * Address.size;-- | Systems.AMD64_SOLARIS =>- (* 64 bytes with 8 byte alignment *)- Jumpbuf_size := 8 * Address.size;-- | Systems.I386_LINUX, Systems.LINUXLIBC6 =>- Jumpbuf_size := 39 * Address.size;-- | Systems.AMD64_LINUX =>- Jumpbuf_size := 25 * Address.size;-- | Systems.I386_DARWIN =>- Jumpbuf_size := 18 * Address.size;-- | Systems.AMD64_DARWIN =>- Jumpbuf_size := ((9 * 2) + 3 + 16) * Int32.size;-- | Systems.ARM_DARWIN =>- Jumpbuf_size := 28 * Address.size;-- | Systems.PPC_DARWIN =>- Jumpbuf_size := 768 * Word8.size;-- | Systems.PPC64_DARWIN =>- Jumpbuf_size := 872 * Word8.size;-- | Systems.PPC_LINUX => - Jumpbuf_size := 74 * Int64.size;- (* ideal alignment is 16 bytes, but 4 is ok *)-- | Systems.PPC32_OPENBSD => - Jumpbuf_size := 100 * Address.size;-- | Systems.I386_NETBSD =>- Jumpbuf_size := 14 * Address.size; (* 13? *)- - | Systems.ALPHA32_VMS,- Systems.ALPHA64_VMS =>- Jumpbuf_size := 68 * Word64.size;--(* | Systems.I386_MSDOS =>- Jumpbuf_size := 172 * Char.size; TBD *)-- | Systems.I386_OPENBSD =>- Jumpbuf_size := 10 * Address.size;-- ELSE RETURN FALSE;+ ELSE END; InitCallingConventions (backend_mode,diff --git a/m3-sys/m3tests/src/p2/p251/Main.m3 b/m3-sys/m3tests/src/p2/p251/Main.m3index 998415e..b6d2d30 100644--- a/m3-sys/m3tests/src/p2/p251/Main.m3+++ b/m3-sys/m3tests/src/p2/p251/Main.m3@@ -172,6 +172,70 @@ BEGIN TRY F6(); EXCEPT END; END Main; +PROCEDURE Finally () =+BEGIN+ (* same thing but in FINALLY, and nested FINALLY *)+ (* NOTE: This testing is haphazard as I don't+ understand exception handling enough to aim for coverage. *)+ TRY+ top_of_stack := GetStack();+ F0();+ FINALLY+ TRY F1(); EXCEPT ELSE Put("exception " & Int(Line())); NL(); END;+ TRY F2(); EXCEPT ELSE Put("exception " & Int(Line())); NL(); END;+ TRY F3(); EXCEPT ELSE Put("exception " & Int(Line())); NL(); END;+ TRY F4(); EXCEPT END;+ TRY F5(); EXCEPT END;+ TRY F6(); EXCEPT END;+ END;+END Finally;++PROCEDURE NestedFinally() =+BEGIN+ (* same thing but in FINALLY, and nested FINALLY *)+ (* NOTE: This testing is haphazard as I don't+ understand exception handling enough to aim for coverage. *)+ TRY+ top_of_stack := GetStack();+ F0();++ FINALLY+ TRY TRY F1(); FINALLY F0(); END; EXCEPT ELSE Put("exception " & Int(Line())); NL(); END;+ TRY TRY F1(); FINALLY F0(); END; EXCEPT ELSE Put("exception " & Int(Line())); NL(); END;+ TRY TRY F1(); FINALLY F0(); END; EXCEPT ELSE Put("exception " & Int(Line())); NL(); END; TRY TRY F1(); FINALLY F0(); END; EXCEPT ELSE Put("exception " & Int(Line())); NL(); END;+ + TRY+ TRY+ F2();+ EXCEPT+ ELSE+ Put("exception " & Int(Line())); NL();+ END;+ FINALLY+ F0();+ END; + END;++ TRY top_of_stack := GetStack(); TRY F0();+ FINALLY TRY F0(); FINALLY F0(); END; END; FINALLY TRY F0(); FINALLY F0(); END; END;+ +END NestedFinally;+ BEGIN Main();++ (* same thing but in Module main *)++ top_of_stack := GetStack();+ F0();+ TRY F1(); EXCEPT ELSE Put("exception " & Int(Line())); NL(); END;+ TRY F2(); EXCEPT ELSE Put("exception " & Int(Line())); NL(); END;+ TRY F3(); EXCEPT ELSE Put("exception " & Int(Line())); NL(); END;+ TRY F4(); EXCEPT END;+ TRY F5(); EXCEPT END;+ TRY F6(); EXCEPT END;+ + Finally();+ NestedFinally();+ END Main.
ok?
- Jay
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://m3lists.elegosoft.com/pipermail/m3devel/attachments/20150806/361b538e/attachment-0002.html>
More information about the M3devel
mailing list