another variant of ALIVE_DEBUGGING; tests for stack underflow detection

engine/engine.c

@@ -134,13 +134,20 @@ extern Char *gforth_memset(Char * s, Cell c, UCell n);
 /* ALIVE_DEBUGGING(x) makes x appear to be used (in the debugging
    engine); we use this in words like DROP to avoid the dead-code
    elimination of the load of the bottom stack item, in order to get
-   precise stack underflow errors; if x is a memory reference (e.g,
-   "*lp"), this will not have an effect, so you have to replace the
-   memory reference with something that does something with the
-   resulting value (e.g., casting it to a Cell if it is not
-   already) */
+   precise stack underflow errors.
+
+   Here's how it works: We first copy x into a variable _x.  The
+   second asm statement makes the compiler believe that it makes use
+   of _x.  The first asm statement makes the compiler believe that the
+   memory location of x may be clobbered, so the compiler actually has
+   to load x into _x if x is a memory reference (e.g., "*lp").
+ */
 #ifdef GFORTH_DEBUGGING
-#define ALIVE_DEBUGGING(x) do { asm volatile(""::"X"(x):"memory"); } while(0)
+#define ALIVE_DEBUGGING(x) \
+  do { typeof(x) _x=(x);         \
+    asm volatile("":::"memory"); \
+    asm volatile(""::"X"(_x):"memory");        \
+  } while(0)
 #else
 #define ALIVE_DEBUGGING(x) ((void)0)
 #endif

prim

@@ -289,7 +289,7 @@ VM_JUMP(EXEC1(EXTRA_CODEXT(a_cfa)));
 branch-lp+!# ( #a_target #nlocals -- )	gforth	branch_lp_plus_store_number
 /* this will probably not be used */
 lp += nlocals;
-ALIVE_DEBUGGING((Cell)*lp);
+ALIVE_DEBUGGING(*lp);
 SET_IP((Xt *)a_target);
 
 \+
@@ -313,7 +313,7 @@ $6
 
 $1-lp+!`#' ( $7 `#'a_target `#'nlocals $2 ) $3_lp_plus_store_number
 $4	$5	lp += nlocals;
-ALIVE_DEBUGGING((Cell)*lp);
+ALIVE_DEBUGGING(*lp);
 SET_IP((Xt *)a_target);
 ifelse(condbranch_opt,`1',`INST_TAIL; NEXT_P2;',`/* condbranch_opt=0 */')
 }
@@ -2510,7 +2510,7 @@ fnegate	( r1 -- r2 )	float	f_negate
 r2 = - r1;
 
 fdrop	( r -- )		float	f_drop
-ALIVE_DEBUGGING(r);
+ALIVE_DEBUGGINGF(r);
 
 fdup	( r -- r r )	float	f_dupe
 
@@ -2866,18 +2866,18 @@ lp+!#	( #noffset -- )	gforth	lp_plus_store_number
 local stack, a positive immediate argument drops memory from the local
 stack""
 lp += noffset;
-ALIVE_DEBUGGING((Cell)*lp);
+ALIVE_DEBUGGING(*lp);
 
 lp-	( -- )	new	lp_minus
 lp += -sizeof(Cell);
 
 lp+	( -- )	new	lp_plus
 lp += sizeof(Float);
-ALIVE_DEBUGGING((Cell)*lp);
+ALIVE_DEBUGGING(*lp);
 
 lp+2	( -- )	new	lp_plus_two
 lp += 2*sizeof(Float);
-ALIVE_DEBUGGING((Cell)*lp);
+ALIVE_DEBUGGING(*lp);
 
 lp!	( c_addr -- )	gforth	lp_store
 lp = (Address)c_addr;

test/gforth-nofast.fs

@@ -102,3 +102,18 @@ environment-wordlist >order
 
 { 0 max-u -1. d+ max-u ' um/mod catch 0= -> max-u 1- max-u true }
 { 0 max-u max-u ' um/mod catch 0= -> 0 max-u max-u false }
+
+
+\ underflow of various stacks; if one of these tests fails, probably
+\ the C compiler has not compiled ALIVE_DEBUGGING as intended.
+
+\ in some cases we THROW at the end to restore the stack depths.
+
+{ :noname rp@ 1000 begin rdrop 1- dup 0= until drop rp! ;          catch dup    -6 = swap -9 = or -> true }
+{ :noname rp@ 1000 begin 2rdrop 1- dup 0= until drop rp! ;         catch dup    -6 = swap -9 = or -> true }
+{ :noname drop drop drop fdrop fdrop fdrop ;                       catch dup    -4 = swap -9 = or -> true }
+{ :noname 2drop 2drop 2drop fdrop fdrop fdrop ;                    catch dup    -4 = swap -9 = or -> true }
+{ :noname fdrop fdrop fdrop 1 throw ;                              catch dup   -45 = swap -9 = or -> true }
+{ :noname 1000 begin lp+!# [ 16 , ] 1- dup 0= until drop 1 throw ; catch dup -2059 = swap -9 = or -> true }
+{ :noname 1000 begin lp+            1- dup 0= until drop 1 throw ; catch dup -2059 = swap -9 = or -> true }
+{ :noname 1000 begin lp+2           1- dup 0= until drop 1 throw ; catch dup -2059 = swap -9 = or -> true }