mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 09:10:22 +02:00
Code Activity

precise stack marking, fix some missed references, still imperfect

Browse source 
* libguile/vm-engine.h (CHECK_STACK_LEAK, NULLSTACK): Add a new mode,
  VM_ENABLE_STACK_NULLING, that tries to ensure that all stack data past
  the top of the stack is NULL. This helps to verify the VM's
  consistency. If VM_ENABLE_STACK_NULLING is not defined, there is no
  overhead.
  (DROP, DROPN): Hook into NULLSTACK.
  (POP_LIST): Hoo, fix a good bug: if CONS triggered a GC, the elements
  of the list that had not yet been consed would not be marked, because
  the sp was already below them.
  (NEXT): Hook into CHECK_STACK_LEAK.
  (INIT_ARGS): Add a note that consing the rest arg can cause GC.
  (NEW_FRAME): Cons up the external data after initializing the frame, so
  that if GC is triggered, the precise marker sees a well-formed frame.

* libguile/vm-i-loader.c (load-program): In the four-integers case, use
  the POP macro so that we can hook into NULLSTACK (if necessary).

* libguile/vm-i-scheme.c (ARGS2, ARGS3): Hook into NULLSTACK.

* libguile/vm-i-system.c (halt): Null the nvalues. Rework some asserts
  into using ASSERT, and null the stack when we free the frame.
  (variable-set): Use DROPN instead of sp -= 2.
  (BR): Hook into NULLSTACK.
  (goto/args): Hook into NULLSTACK. In the non-self case, delay updating
  the frame until after INIT_ARGS so that GC sees a well-formed frame.
  Delay consing the externals until after the frame is set up, as in
  NEW_FRAME.
  (call/cc): Add some asserts.
  (return): Rework some asserts into ASSERT, and hook into NULLSTACK.
  (return/values): Hook into NULLSTACK, and use ASSERT.
  (return/values*) Use ASSERT.

* libguile/vm.c (VM_ENABLE_ASSERTIONS, VM_ENABLE_STACK_NULLING): These
  are the variables that control assertions and nulling. Perhaps we can
  do these per-engine when we start compiling the debug engine separate
  from a speedy engine.
  (vm_mark_stack): Add a precise stack marker. Yay!
  (vm_cont_mark): Mark the continuation stack precisely.
  (capture_vm_cont): Record the difference from the vp's stack_base too,
  so that we can translate the dynamic links when marking the
  continuation stack. Memset the stack to NULL if we are doing nulling.
  (reinstate_vm_cont): If we are nulling, null out the relevant part
  of the stack.
  (vm_reset_stack): When resetting sp due to a nonlocal exit, null out
  the stack too.
  (vm_mark): If we are nulling, assert that there are no extra values on
  the stack. Mark the stack precisely.
This commit is contained in:
Andy Wingo 2008-10-03 16:00:30 +02:00
parent edb1d1d78d
commit 11ea1aba9e
5 changed files with 157 additions and 61 deletions
Download patch file Download diff file Expand all files Collapse all files

49
libguile/vm-engine.h
View file

@ -127,9 +127,7 @@
* Cache/Sync
*/
#define ENABLE_ASSERTIONS
#ifdef ENABLE_ASSERTIONS
#ifdef VM_ENABLE_ASSERTIONS
# define ASSERT(condition) if (SCM_UNLIKELY (!(condition))) abort()
#else
# define ASSERT(condition)
@ -151,7 +149,7 @@
vp->fp = fp; \
}
#ifdef IP_PARANOIA
#ifdef VM_ENABLE_PARANOID_ASSERTIONS
#define CHECK_IP() \
do { if (ip < bp->base || ip - bp->base > bp->size) abort (); } while (0)
#else
@ -245,6 +243,16 @@
* Stack operation
*/
#ifdef VM_ENABLE_STACK_NULLING
# define CHECK_STACK_LEAKN(_n) ASSERT (!sp[_n]);
# define CHECK_STACK_LEAK() CHECK_STACK_LEAKN(1)
# define NULLSTACK(_n) { int __x = _n; CHECK_STACK_LEAKN (_n+1); while (__x > 0) sp[__x--] = NULL; }
#else
# define CHECK_STACK_LEAKN(_n)
# define CHECK_STACK_LEAK()
# define NULLSTACK(_n)
#endif
#define CHECK_OVERFLOW() \
if (sp > stack_limit) \
goto vm_error_stack_overflow
@ -254,8 +262,8 @@
goto vm_error_stack_underflow;
#define PUSH(x) do { sp++; CHECK_OVERFLOW (); *sp = x; } while (0)
#define DROP() do { sp--; CHECK_UNDERFLOW (); } while (0)
#define DROPN(_n) do { sp -= (_n); CHECK_UNDERFLOW (); } while (0)
#define DROP() do { sp--; CHECK_UNDERFLOW (); NULLSTACK (1); } while (0)
#define DROPN(_n) do { sp -= (_n); CHECK_UNDERFLOW (); NULLSTACK (_n); } while (0)
#define POP(x) do { x = *sp; DROP (); } while (0)
/* A fast CONS. This has to be fast since its used, for instance, by
@ -275,10 +283,12 @@
do \
{ \
int i; \
SCM l = SCM_EOL; \
sp -= n; \
for (i = n; i; i--) \
CONS (l, sp[i], l); \
SCM l = SCM_EOL, x; \
for (i = n; i; i--) \
{ \
POP (x); \
CONS (l, x, l); \
} \
PUSH (l); \
} while (0)
@ -404,6 +414,7 @@ do { \
{ \
CLOCK (1); \
NEXT_HOOK (); \
CHECK_STACK_LEAK (); \
NEXT_JUMP (); \
}
@ -419,6 +430,8 @@ do { \
int n = nargs - (bp->nargs - 1); \
if (n < 0) \
goto vm_error_wrong_num_args; \
/* NB, can cause GC while setting up the \
stack frame */ \
POP_LIST (n); \
} \
else \
@ -453,17 +466,21 @@ do { \
for (i=bp->nlocs; i; i--) \
data[-i] = SCM_UNDEFINED; \
\
/* Create external variables */ \
external = bp->external; \
for (i = 0; i < bp->nexts; i++) \
CONS (external, SCM_UNDEFINED, external); \
\
/* Set frame data */ \
data[4] = (SCM)ra; \
data[3] = 0x0; \
data[2] = (SCM)dl; \
data[1] = SCM_BOOL_F; \
data[0] = external; \
\
/* Postpone initializing external vars, \
because if the CONS causes a GC, we \
want the stack marker to see the data \
array formatted as expected. */ \
data[0] = SCM_UNDEFINED; \
external = bp->external; \
for (i = 0; i < bp->nexts; i++) \
CONS (external, SCM_UNDEFINED, external); \
data[0] = external; \
}
#define CACHE_EXTERNAL() external = fp[bp->nargs + bp->nlocs]

9
libguile/vm-i-loader.c
View file

@ -152,11 +152,10 @@ VM_DEFINE_LOADER (load_program, "load-program")
{
/* Other cases */
/* x is #f, and already popped off */
p->nargs = SCM_I_INUM (sp[-3]);
p->nrest = SCM_I_INUM (sp[-2]);
p->nlocs = SCM_I_INUM (sp[-1]);
p->nexts = SCM_I_INUM (sp[0]);
sp -= 4;
POP (x); p->nexts = scm_to_unsigned_integer (x, 0, 255);
POP (x); p->nlocs = scm_to_unsigned_integer (x, 0, 255);
POP (x); p->nrest = scm_to_unsigned_integer (x, 0, 1);
POP (x); p->nargs = scm_to_unsigned_integer (x, 0, 255);
}
PUSH (prog);

4
libguile/vm-i-scheme.c
View file

@ -47,8 +47,8 @@
*/
#define ARGS1(a1) SCM a1 = sp[0];
#define ARGS2(a1,a2) SCM a1 = sp[-1], a2 = sp[0]; sp--;
#define ARGS3(a1,a2,a3) SCM a1 = sp[-2], a2 = sp[-1], a3 = sp[0]; sp -= 2;
#define ARGS2(a1,a2) SCM a1 = sp[-1], a2 = sp[0]; sp--; NULLSTACK (1);
#define ARGS3(a1,a2,a3) SCM a1 = sp[-2], a2 = sp[-1], a3 = sp[0]; sp -= 2; NULLSTACK (2);
#define RETURN(x) do { *sp = x; NEXT; } while (0)

73
libguile/vm-i-system.c
View file

@ -58,6 +58,7 @@ VM_DEFINE_INSTRUCTION (halt, "halt", 0, 0, 0)
vp->time += scm_c_get_internal_run_time () - start_time;
HALT_HOOK ();
nvalues = SCM_I_INUM (*sp--);
NULLSTACK (1);
if (nvalues == 1)
POP (ret);
else
@ -69,17 +70,14 @@ VM_DEFINE_INSTRUCTION (halt, "halt", 0, 0, 0)
}
{
#ifdef THE_GOVERNMENT_IS_AFTER_ME
if (sp != stack_base)
abort ();
if (stack_base != SCM_FRAME_UPPER_ADDRESS (fp) - 1)
abort ();
#endif
ASSERT (sp == stack_base);
ASSERT (stack_base == SCM_FRAME_UPPER_ADDRESS (fp) - 1);
/* Restore registers */
sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1;
ip = NULL;
fp = SCM_FRAME_DYNAMIC_LINK (fp);
NULLSTACK (stack_base - sp);
}
SYNC_ALL ();
scm_dynwind_end ();
@ -366,7 +364,7 @@ VM_DEFINE_INSTRUCTION (external_set, "external-set", 1, 1, 0)
VM_DEFINE_INSTRUCTION (variable_set, "variable-set", 0, 1, 0)
{
VARIABLE_SET (sp[0], sp[-1]);
sp -= 2;
DROPN (2);
NEXT;
}
@ -435,6 +433,7 @@ VM_DEFINE_INSTRUCTION (late_variable_set, "late-variable-set", 1, 1, 0)
FETCH_OFFSET (offset); \
if (p) \
ip += offset; \
NULLSTACK (1); \
DROP (); \
NEXT; \
}
@ -621,6 +620,7 @@ VM_DEFINE_INSTRUCTION (goto_args, "goto/args", 1, -1, 1)
/* Drop the first argument and the program itself. */
sp -= 2;
NULLSTACK (bp->nargs + 1)
/* Call itself */
ip = bp->base;
@ -636,6 +636,9 @@ VM_DEFINE_INSTRUCTION (goto_args, "goto/args", 1, -1, 1)
SCM *data, *tail_args, *dl;
int i;
scm_byte_t *ra, *mvra;
#ifdef VM_ENABLE_STACK_NULLING
SCM *old_sp;
#endif
EXIT_HOOK ();
@ -646,11 +649,19 @@ VM_DEFINE_INSTRUCTION (goto_args, "goto/args", 1, -1, 1)
dl = SCM_FRAME_DYNAMIC_LINK (fp);
/* switch programs */
fp[-1] = program = x;
program = x;
CACHE_PROGRAM ();
INIT_ARGS ();
/* delay updating the frame so that if INIT_ARGS has to cons up a rest
arg, going into GC, the stack still makes sense */
fp[-1] = program;
nargs = bp->nargs;
#ifdef VM_ENABLE_STACK_NULLING
old_sp = sp;
CHECK_STACK_LEAK ();
#endif
/* new registers -- logically this would be better later, but let's make
sure we have space for the locals now */
data = SCM_FRAME_DATA_ADDRESS (fp);
@ -663,21 +674,26 @@ VM_DEFINE_INSTRUCTION (goto_args, "goto/args", 1, -1, 1)
for (i = 0; i < nargs; i++)
fp[i] = tail_args[i];
NULLSTACK (old_sp - sp);
/* init locals */
for (i = bp->nlocs; i; i--)
data[-i] = SCM_UNDEFINED;
/* and the external variables */
external = bp->external;
for (i = 0; i < bp->nexts; i++)
CONS (external, SCM_UNDEFINED, external);
/* Set frame data */
data[4] = (SCM)ra;
data[3] = (SCM)mvra;
data[2] = (SCM)dl;
data[1] = SCM_BOOL_F;
/* Postpone initializing external vars, because if the CONS causes a GC,
we want the stack marker to see the data array formatted as expected. */
data[0] = SCM_UNDEFINED;
external = bp->external;
for (i = 0; i < bp->nexts; i++)
CONS (external, SCM_UNDEFINED, external);
data[0] = external;
ENTER_HOOK ();
APPLY_HOOK ();
NEXT;
@ -887,6 +903,9 @@ VM_DEFINE_INSTRUCTION (call_cc, "call/cc", 0, 1, 1)
nargs = 1;
goto vm_call;
}
ASSERT (sp == vp->sp);
ASSERT (fp == vp->fp);
ASSERT (ip == vp->ip);
else if (SCM_VALUESP (cont))
{
/* multiple values returned to continuation */
@ -946,18 +965,20 @@ VM_DEFINE_INSTRUCTION (return, "return", 0, 0, 1)
data = SCM_FRAME_DATA_ADDRESS (fp);
POP (ret);
#ifdef THE_GOVERNMENT_IS_AFTER_ME
if (sp != stack_base)
abort ();
if (stack_base != data + 4)
abort ();
#endif
ASSERT (sp == stack_base);
ASSERT (stack_base == data + 4);
/* Restore registers */
sp = SCM_FRAME_LOWER_ADDRESS (fp);
ip = SCM_FRAME_BYTE_CAST (data[4]);
fp = SCM_FRAME_STACK_CAST (data[2]);
stack_base = SCM_FRAME_UPPER_ADDRESS (fp) - 1;
{
#ifdef VM_ENABLE_STACK_NULLING
int nullcount = stack_base - sp;
#endif
stack_base = SCM_FRAME_UPPER_ADDRESS (fp) - 1;
NULLSTACK (nullcount);
}
/* Set return value (sp is already pushed) */
*sp = ret;
@ -983,10 +1004,7 @@ VM_DEFINE_INSTRUCTION (return_values, "return/values", 1, -1, -1)
RETURN_HOOK ();
data = SCM_FRAME_DATA_ADDRESS (fp);
#ifdef THE_GOVERNMENT_IS_AFTER_ME
if (stack_base != data + 4)
abort ();
#endif
ASSERT (stack_base == data + 4);
/* data[3] is the mv return address */
if (nvalues != 1 && data[3])
@ -1003,6 +1021,7 @@ VM_DEFINE_INSTRUCTION (return_values, "return/values", 1, -1, -1)
*++sp = SCM_I_MAKINUM (nvalues);
/* Finally set new stack_base */
NULLSTACK (stack_base - sp + nvalues + 1);
stack_base = SCM_FRAME_UPPER_ADDRESS (fp) - 1;
}
else if (nvalues >= 1)
@ -1020,6 +1039,7 @@ VM_DEFINE_INSTRUCTION (return_values, "return/values", 1, -1, -1)
*++sp = stack_base[1];
/* Finally set new stack_base */
NULLSTACK (stack_base - sp);
stack_base = SCM_FRAME_UPPER_ADDRESS (fp) - 1;
}
else
@ -1038,10 +1058,7 @@ VM_DEFINE_INSTRUCTION (return_values_star, "return/values*", 1, -1, -1)
SCM l;
nvalues = FETCH ();
#ifdef THE_GOVERNMENT_IS_AFTER_ME
if (nvalues < 1)
abort ();
#endif
ASSERT (nvalues >= 1);
nvalues--;
POP (l);

83
libguile/vm.c
View file

@ -58,6 +58,20 @@
scm_newline (scm_current_error_port ()); \
}
/* The VM has a number of internal assertions that shouldn't normally be
necessary, but might be if you think you found a bug in the VM. */
#define VM_ENABLE_ASSERTIONS
/* We can add a mode that ensures that all stack items above the stack pointer
are NULL. This is useful for checking the internal consistency of the VM's
assumptions and its operators, but isn't necessary for normal operation. It
will ensure that assertions are enabled. */
#define VM_ENABLE_STACK_NULLING
#if defined (VM_ENABLE_STACK_NULLING) && !defined (VM_ENABLE_ASSERTIONS)
#define VM_ENABLE_ASSERTIONS
#endif
/*
* VM Continuation
@ -71,23 +85,53 @@ struct scm_vm_cont {
scm_t_ptrdiff fp;
scm_t_ptrdiff stack_size;
SCM *stack_base;
scm_t_ptrdiff reloc;
};
#define SCM_VM_CONT_P(OBJ) SCM_SMOB_PREDICATE (scm_tc16_vm_cont, OBJ)
#define SCM_VM_CONT_DATA(CONT) ((struct scm_vm_cont *) SCM_CELL_WORD_1 (CONT))
static void
vm_mark_stack (SCM *base, scm_t_ptrdiff size, SCM *fp, scm_t_ptrdiff reloc)
{
SCM *sp, *upper, *lower;
sp = base + size - 1;
while (sp > base && fp)
{
upper = SCM_FRAME_UPPER_ADDRESS (fp);
lower = SCM_FRAME_LOWER_ADDRESS (fp);
for (; sp >= upper; sp--)
if (SCM_NIMP (*sp))
{
if (scm_in_heap_p (*sp))
scm_gc_mark (*sp);
else
fprintf (stderr, "BADNESS: crap on the stack: %p\n", *sp);
}
/* skip ra, mvra */
sp -= 2;
/* update fp from the dynamic link */
fp = (SCM*)*sp-- + reloc;
/* mark from the hl down to the lower address */
for (; sp >= lower; sp--)
if (*sp && SCM_NIMP (*sp))
scm_gc_mark (*sp);
}
}
static SCM
vm_cont_mark (SCM obj)
{
size_t size;
SCM *stack;
struct scm_vm_cont *p = SCM_VM_CONT_DATA (obj);
stack = SCM_VM_CONT_DATA (obj)->stack_base;
size = SCM_VM_CONT_DATA (obj)->stack_size;
/* we could be smarter about this. */
scm_mark_locations ((SCM_STACKITEM *) stack, size);
vm_mark_stack (p->stack_base, p->stack_size, p->stack_base + p->fp, p->reloc);
return SCM_BOOL_F;
}
@ -110,10 +154,14 @@ capture_vm_cont (struct scm_vm *vp)
p->stack_size = vp->sp - vp->stack_base + 1;
p->stack_base = scm_gc_malloc (p->stack_size * sizeof (SCM),
"capture_vm_cont");
#ifdef VM_ENABLE_STACK_NULLING
memset (p->stack_base, 0, p->stack_size * sizeof (SCM));
#endif
p->ip = vp->ip;
p->sp = vp->sp - vp->stack_base;
p->fp = vp->fp - vp->stack_base;
memcpy (p->stack_base, vp->stack_base, p->stack_size * sizeof (SCM));
p->reloc = p->stack_base - vp->stack_base;
SCM_RETURN_NEWSMOB (scm_tc16_vm_cont, p);
}
@ -126,6 +174,13 @@ reinstate_vm_cont (struct scm_vm *vp, SCM cont)
/* puts ("FIXME: Need to expand"); */
abort ();
}
#ifdef VM_ENABLE_STACK_NULLING
{
scm_t_ptrdiff nzero = (vp->sp - vp->stack_base) - p->sp;
if (nzero > 0)
memset (vp->stack_base + p->stack_size, 0, nzero);
}
#endif
vp->ip = p->ip;
vp->sp = vp->stack_base + p->sp;
vp->fp = vp->stack_base + p->fp;
@ -173,6 +228,9 @@ vm_reset_stack (void *data)
w->vp->sp = w->sp;
w->vp->fp = w->fp;
w->vp->this_frame = w->this_frame;
#ifdef VM_ENABLE_STACK_NULLING
memset (w->vp->sp + 1, 0, w->vp->stack_size - (w->vp->sp + 1 - w->vp->stack_base));
#endif
}
@ -329,9 +387,14 @@ vm_mark (SCM obj)
int i;
struct scm_vm *vp = SCM_VM_DATA (obj);
/* mark the stack conservatively */
scm_mark_locations ((SCM_STACKITEM *) vp->stack_base,
sizeof (SCM)*(vp->sp + 1 - vp->stack_base));
#ifdef VM_ENABLE_STACK_NULLING
if (vp->sp >= vp->stack_base)
if (!vp->sp[0] || vp->sp[1])
abort ();
#endif
/* mark the stack, precisely */
vm_mark_stack (vp->stack_base, vp->sp + 1 - vp->stack_base, vp->fp, 0);
/* mark other objects */
for (i = 0; i < SCM_VM_NUM_HOOKS; i++)