Commit 9e26f876 authored by Anton Ertl's avatar Anton Ertl
Browse files

another variant of ALIVE_DEBUGGING; tests for stack underflow detection

parent 61f4cf29

engine/engine.c

+13 −6
Original line number Diff line number Diff line
@@ -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

+6 −6
Original line number Diff line number Diff line
@@ -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

+15 −0
Original line number Diff line number Diff line
@@ -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 }