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

another variant of ALIVE_DEBUGGING; tests for stack underflow detection

parent 61f4cf29
...@@ -134,13 +134,20 @@ extern Char *gforth_memset(Char * s, Cell c, UCell n); ...@@ -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 /* 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 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 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, precise stack underflow errors.
"*lp"), this will not have an effect, so you have to replace the
memory reference with something that does something with the Here's how it works: We first copy x into a variable _x. The
resulting value (e.g., casting it to a Cell if it is not second asm statement makes the compiler believe that it makes use
already) */ 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 #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 #else
#define ALIVE_DEBUGGING(x) ((void)0) #define ALIVE_DEBUGGING(x) ((void)0)
#endif #endif
......
...@@ -289,7 +289,7 @@ VM_JUMP(EXEC1(EXTRA_CODEXT(a_cfa))); ...@@ -289,7 +289,7 @@ VM_JUMP(EXEC1(EXTRA_CODEXT(a_cfa)));
branch-lp+!# ( #a_target #nlocals -- ) gforth branch_lp_plus_store_number branch-lp+!# ( #a_target #nlocals -- ) gforth branch_lp_plus_store_number
/* this will probably not be used */ /* this will probably not be used */
lp += nlocals; lp += nlocals;
ALIVE_DEBUGGING((Cell)*lp); ALIVE_DEBUGGING(*lp);
SET_IP((Xt *)a_target); SET_IP((Xt *)a_target);
\+ \+
...@@ -313,7 +313,7 @@ $6 ...@@ -313,7 +313,7 @@ $6
$1-lp+!`#' ( $7 `#'a_target `#'nlocals $2 ) $3_lp_plus_store_number $1-lp+!`#' ( $7 `#'a_target `#'nlocals $2 ) $3_lp_plus_store_number
$4 $5 lp += nlocals; $4 $5 lp += nlocals;
ALIVE_DEBUGGING((Cell)*lp); ALIVE_DEBUGGING(*lp);
SET_IP((Xt *)a_target); SET_IP((Xt *)a_target);
ifelse(condbranch_opt,`1',`INST_TAIL; NEXT_P2;',`/* condbranch_opt=0 */') ifelse(condbranch_opt,`1',`INST_TAIL; NEXT_P2;',`/* condbranch_opt=0 */')
} }
...@@ -2510,7 +2510,7 @@ fnegate ( r1 -- r2 ) float f_negate ...@@ -2510,7 +2510,7 @@ fnegate ( r1 -- r2 ) float f_negate
r2 = - r1; r2 = - r1;
fdrop ( r -- ) float f_drop fdrop ( r -- ) float f_drop
ALIVE_DEBUGGING(r); ALIVE_DEBUGGINGF(r);
fdup ( r -- r r ) float f_dupe fdup ( r -- r r ) float f_dupe
...@@ -2866,18 +2866,18 @@ lp+!# ( #noffset -- ) gforth lp_plus_store_number ...@@ -2866,18 +2866,18 @@ lp+!# ( #noffset -- ) gforth lp_plus_store_number
local stack, a positive immediate argument drops memory from the local local stack, a positive immediate argument drops memory from the local
stack"" stack""
lp += noffset; lp += noffset;
ALIVE_DEBUGGING((Cell)*lp); ALIVE_DEBUGGING(*lp);
lp- ( -- ) new lp_minus lp- ( -- ) new lp_minus
lp += -sizeof(Cell); lp += -sizeof(Cell);
lp+ ( -- ) new lp_plus lp+ ( -- ) new lp_plus
lp += sizeof(Float); lp += sizeof(Float);
ALIVE_DEBUGGING((Cell)*lp); ALIVE_DEBUGGING(*lp);
lp+2 ( -- ) new lp_plus_two lp+2 ( -- ) new lp_plus_two
lp += 2*sizeof(Float); lp += 2*sizeof(Float);
ALIVE_DEBUGGING((Cell)*lp); ALIVE_DEBUGGING(*lp);
lp! ( c_addr -- ) gforth lp_store lp! ( c_addr -- ) gforth lp_store
lp = (Address)c_addr; lp = (Address)c_addr;
......
...@@ -102,3 +102,18 @@ environment-wordlist >order ...@@ -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 -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 } { 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 }
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment