Back to index

plt-scheme  4.2.1
Classes | Defines | Typedefs | Functions | Variables
setjmpup.c File Reference
#include "schpriv.h"
#include "schmach.h"
#include "schgc.h"

Go to the source code of this file.

Classes

struct  CopiedStack

Defines

#define SCHEME_NO_GC_PROTO
#define DEEPPOS(b)   ((unsigned long)(b)->stack_from)
#define get_copy(s_c)   (((CopiedStack *)s_c)->_stack_copy)
#define MALLOC_LINK()   MALLOC_ONE_WEAK(CopiedStack*)
#define MALLOC_STACK(size)   scheme_malloc_atomic(size)
#define GC_VAR_STACK_ARG_DECL   /* empty */
#define GC_VAR_STACK_ARG   /* empty */
#define MAX_STACK_DIFF   4096
#define SHARED_STACK_ALIGNMENT   4
#define ALIGN_VAR_STACK(vs, s)   /* empty */
#define PAST_VAR_STACK(s)   /* empty */
#define PAST_VAR_STACK_DELTA(s, d)   /* empty */

Typedefs

typedef struct CopiedStack CopiedStack

Functions

MZ_DLLIMPORT void GC_push_all_stack (void *, void *)
MZ_DLLIMPORT void GC_flush_mark_stack (void)
MZ_DLLIMPORT int GC_is_marked (void *)
MZ_DLLIMPORT int GC_did_mark_stack_overflow (void)
static void push_copied_stacks (int init)
static void init_push_copied_stacks (void)
static void update_push_copied_stacks (void)
void scheme_init_setjumpup (void)
static void remove_cs (void *_cs, void *unused)
static voidmake_stack_copy_rec (long size)
static void set_copy (void *s_c, void *c)
void MZ_NO_INLINE scheme_copy_stack (Scheme_Jumpup_Buf *b, void *base, void *start GC_VAR_STACK_ARG_DECL)
 MZ_DO_NOT_INLINE (void scheme_uncopy_stack(int ok, Scheme_Jumpup_Buf *b, long *prev))
void scheme_uncopy_stack (int ok, Scheme_Jumpup_Buf *b, long *prev)
static long find_same (char *p, char *low, long max_size)
int scheme_setjmpup_relative (Scheme_Jumpup_Buf *b, void *base, void *volatile start, struct Scheme_Cont *c)
struct Scheme_Overflow_Jmpscheme_prune_jmpup (struct Scheme_Overflow_Jmp *jmp, void *stack_boundary)
void scheme_longjmpup (Scheme_Jumpup_Buf *b)
void scheme_init_jmpup_buf (Scheme_Jumpup_Buf *b)
void scheme_reset_jmpup_buf (Scheme_Jumpup_Buf *b)

Variables

MZ_DLLIMPORT void(* GC_push_last_roots )(void)
MZ_DLLIMPORT void(* GC_push_last_roots_again )(void)
static CopiedStack ** first_copied_stack
int scheme_num_copied_stacks = 0

Class Documentation

struct CopiedStack

Definition at line 77 of file setjmpup.c.

Collaboration diagram for CopiedStack:
Class Members
void * _stack_copy
struct CopiedStack ** next
struct CopiedStack ** prev
int pushed
long size

Define Documentation

#define ALIGN_VAR_STACK (   vs,
 
)    /* empty */

Definition at line 490 of file setjmpup.c.

#define DEEPPOS (   b)    ((unsigned long)(b)->stack_from)

Definition at line 34 of file setjmpup.c.

#define GC_VAR_STACK_ARG   /* empty */

Definition at line 247 of file setjmpup.c.

#define GC_VAR_STACK_ARG_DECL   /* empty */

Definition at line 246 of file setjmpup.c.

#define get_copy (   s_c)    (((CopiedStack *)s_c)->_stack_copy)

Definition at line 67 of file setjmpup.c.

Definition at line 69 of file setjmpup.c.

Definition at line 74 of file setjmpup.c.

#define MAX_STACK_DIFF   4096
#define PAST_VAR_STACK (   s)    /* empty */

Definition at line 491 of file setjmpup.c.

#define PAST_VAR_STACK_DELTA (   s,
 
)    /* empty */

Definition at line 492 of file setjmpup.c.

Definition at line 24 of file setjmpup.c.

#define SHARED_STACK_ALIGNMENT   4

Typedef Documentation


Function Documentation

static long find_same ( char *  p,
char *  low,
long  max_size 
) [static]

Definition at line 389 of file setjmpup.c.

{
  long cnt = 0;

  /* We assume a max possible amount of the current stack that should
     not be shared with the saved stack. This is ok (or not) in the same
     sense as assuming that STACK_SAFETY_MARGIN is enough wiggle room to
     prevent stack overflow. */
# define MAX_STACK_DIFF 4096

#ifdef SIXTY_FOUR_BIT_INTEGERS
# define SHARED_STACK_ALIGNMENT 8
#else
# define SHARED_STACK_ALIGNMENT 4
#endif

  if (max_size > MAX_STACK_DIFF) {
    cnt = max_size - MAX_STACK_DIFF;
    max_size = MAX_STACK_DIFF;
  }

#ifdef STACK_GROWS_UP
  while (max_size--) {
    if (p[cnt] != low[cnt])
      break;
    cnt++;
  }
#else
  while (max_size--) {
    if (p[max_size] != low[max_size])
      break;
    cnt++;
  }
#endif

  if (cnt & (SHARED_STACK_ALIGNMENT - 1)) {
    cnt -= (cnt & (SHARED_STACK_ALIGNMENT - 1));
  }

  return cnt;
}

Here is the caller graph for this function:

Definition at line 599 of file mark.c.

{
  return GC_mark_state == MS_INVALID;
}

Definition at line 664 of file mark_rts.c.

Here is the call graph for this function:

Definition at line 4314 of file sgc.c.

{
  unsigned long s, e;

  s = PTR_TO_INT(sp);
  e = PTR_TO_INT(ep);

  PUSH_COLLECT(s, e, 0);

  prepare_stack_collect();
}

Here is the call graph for this function:

static void init_push_copied_stacks ( void  ) [static]

Definition at line 129 of file setjmpup.c.

Here is the call graph for this function:

Here is the caller graph for this function:

static void* make_stack_copy_rec ( long  size) [static]

Definition at line 177 of file setjmpup.c.

{
  CopiedStack *cs, **lk;

  cs = MALLOC_ONE(CopiedStack);
  cs->size = size;
  lk = MALLOC_LINK();
  cs->next = lk;
  lk = MALLOC_LINK();
  cs->prev = lk;


  /* double linked list push */
  *cs->next = *first_copied_stack;
  if (*first_copied_stack)
    *(*first_copied_stack)->prev = cs;
  *cs->prev = NULL;
  *first_copied_stack = cs;

  GC_register_finalizer(cs, remove_cs, NULL, NULL, NULL);

  scheme_num_copied_stacks++;

  return (void *)cs;
}

Here is the call graph for this function:

Here is the caller graph for this function:

MZ_DO_NOT_INLINE ( void   scheme_uncopy_stackint ok, Scheme_Jumpup_Buf *b, long *prev)
static void push_copied_stacks ( int  init) [static]

Definition at line 87 of file setjmpup.c.

{
  /* This is called after everything else is marked.
     Mark from those stacks that are still reachable. If
     we mark from a stack, we need to go back though the list
     all over to check the previously unmarked stacks. */
  CopiedStack *cs;
  int pushed_one;

  if (init) {
    for (cs = *first_copied_stack; cs; cs = *cs->next) {
      if (get_copy(cs))
       cs->pushed = 0;
      else
       cs->pushed = 1;
    }
  }

  GC_flush_mark_stack();

  do {
    pushed_one = 0;
    for (cs = *first_copied_stack; cs; cs = *cs->next) {
      if (!cs->pushed && GC_is_marked(get_copy(cs))) {
       pushed_one = 1;
       cs->pushed = 1;
       GC_push_all_stack(get_copy(cs), (char *)get_copy(cs) + cs->size);
       if (GC_did_mark_stack_overflow()) {
         /* printf("mark stack overflow\n"); */
         return;
       } else {
         GC_flush_mark_stack();
         if (GC_did_mark_stack_overflow()) {
           /* printf("mark stack overflow (late)\n"); */
           return;
         }
       }
      }
    }
  } while (pushed_one);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void remove_cs ( void _cs,
void unused 
) [static]

Definition at line 153 of file setjmpup.c.

{
  CopiedStack *cs = (CopiedStack *)_cs;

  if (*cs->prev)
    *(*cs->prev)->next = *cs->next;
  else
    *first_copied_stack = *cs->next;

  if (*cs->next)
    *(*cs->next)->prev = *cs->prev;

  if (cs->_stack_copy) {
#ifndef SGC_STD_DEBUGGING
    GC_free(cs->_stack_copy);
#else
    memset(cs->_stack_copy, 0, cs->size);
#endif
    cs->_stack_copy = NULL;
  }

  --scheme_num_copied_stacks;
}

Here is the call graph for this function:

Here is the caller graph for this function:

void MZ_NO_INLINE scheme_copy_stack ( Scheme_Jumpup_Buf b,
void base,
void *start  GC_VAR_STACK_ARG_DECL 
)

Definition at line 251 of file setjmpup.c.

{
  long size, msize;
  void *here;

  here = &size;

  size = (long)here XFORM_OK_MINUS (long)start;
#ifdef STACK_GROWS_UP
  b->stack_from = start;
#else
  size = -size;
  b->stack_from = here;
#endif

  if (size < 0)
    size = 0;

  msize = size;

  if (b->stack_max_size < size) {
    /* printf("Stack size: %d\n", size); */
    void *copy;
#ifndef MZ_PRECISE_GC
    copy = make_stack_copy_rec(size);
    b->stack_copy = copy;
    set_copy(b->stack_copy, MALLOC_STACK(size));
#else
    /* b is a pointer into the middle of `base'; bad for precise gc: */
    unsigned long diff;
    diff = (unsigned long)b XFORM_OK_MINUS (unsigned long)base;
    b = NULL;

    copy = NULL;
    /* Look for a reusable freed block: */
    {
      int i;
      for (i = 0; i < STACK_COPY_CACHE_SIZE; i++) {
       if ((stack_copy_size_cache[i] >= size)
           && (stack_copy_size_cache[i] < (size + SCC_OK_EXTRA_AMT))) {
         /* Found one */
         copy = stack_copy_cache[i];
         msize = stack_copy_size_cache[i];
         stack_copy_cache[i] = NULL;
         stack_copy_size_cache[i] = 0;
         break;
       }
      }
    }
    if (!copy) {
      /* No reusable block found */
      copy = MALLOC_STACK(size);
    }

    /* Restore b: */
    b = (Scheme_Jumpup_Buf *)(((char *)base) XFORM_OK_PLUS diff);

    set_copy(b->stack_copy, copy);
#endif
    b->stack_max_size = msize;
  }
  b->stack_size = size;

#ifdef MZ_PRECISE_GC
  b->gc_var_stack = gc_var_stack_in;
  if (scheme_get_external_stack_val) {
    void *es;
    es = scheme_get_external_stack_val();
    b->external_stack = es;
  }
#endif

  memcpy(get_copy(b->stack_copy),
        b->stack_from,
        size);
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 627 of file setjmpup.c.

{
  b->stack_size = b->stack_max_size = 0;
  b->stack_from = b->stack_copy = NULL;
}

Definition at line 141 of file setjmpup.c.

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 615 of file setjmpup.c.

{
  long z;
  long junk[200];

#ifdef MZ_USE_JIT
  scheme_flush_stack_cache();
#endif

  scheme_uncopy_stack(STK_COMP((unsigned long)&z, DEEPPOS(b)), b, junk);
}

Here is the call graph for this function:

struct Scheme_Overflow_Jmp* scheme_prune_jmpup ( struct Scheme_Overflow_Jmp jmp,
void stack_boundary 
) [read]

Definition at line 559 of file setjmpup.c.

{
  void *cur_end;

  PAST_VAR_STACK_DELTA(stack_boundary,  (char *)get_copy(jmp->cont.stack_copy) - (char *)jmp->cont.stack_from);

#ifdef STACK_GROWS_UP
  cur_end = (void *)jmp->cont.stack_from;
#else
  cur_end = (void *)((char *)jmp->cont.stack_from + jmp->cont.stack_size);
#endif

  if (stack_boundary != cur_end) {
    long new_size, delta;
    Scheme_Overflow_Jmp *naya;
    void *copy, *base;

# ifdef STACK_GROWS_UP
    delta = (char *)stack_boundary - (char *)jmp->cont.stack_from;
    new_size = jmp->cont.stack_size - delta;
    base = (char *)stack_boundary;
# else
    delta = 0;
    new_size = (long)stack_boundary - (long)jmp->cont.stack_from;
    base = jmp->cont.stack_from;
# endif

    if ((new_size < 0) || (new_size > jmp->cont.stack_size))
      scheme_signal_error("bad C-stack pruigin size: %ld vs. %ld", new_size, jmp->cont.stack_size);

    naya = MALLOC_ONE_RT(Scheme_Overflow_Jmp);
    memcpy(naya, jmp, sizeof(Scheme_Overflow_Jmp));
    scheme_init_jmpup_buf(&naya->cont);
    
#ifndef MZ_PRECISE_GC
    copy = make_stack_copy_rec(new_size);
    naya->cont.stack_copy = copy;
    set_copy(naya->cont.stack_copy, MALLOC_STACK(new_size));
#else
    copy = MALLOC_STACK(new_size);
    set_copy(naya->cont.stack_copy, copy);
#endif
    
    memcpy(get_copy(copy), 
           (char *)get_copy(jmp->cont.stack_copy) XFORM_OK_PLUS delta,
           new_size);

    naya->cont.stack_size = naya->cont.stack_max_size = new_size;
    naya->cont.stack_from = base;

    return naya;
  }

  return NULL;
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 633 of file setjmpup.c.

{
  if (b->stack_copy) {
#ifdef MZ_PRECISE_GC
    /* "Free" the stack copy by putting it into a cache.
       (We clear the cache before a GC.) */
    stack_copy_cache[scc_pos] = b->stack_copy;
    stack_copy_size_cache[scc_pos] = b->stack_max_size;
    scc_pos++;
    if (scc_pos == STACK_COPY_CACHE_SIZE)
      scc_pos = 0;
#else
    /* Drop the copy of the stack, */
    /* remove the finalizer, */
    /* and explicitly call the finalization proc */
    GC_register_finalizer(b->stack_copy, NULL, NULL, NULL, NULL);
    remove_cs(b->stack_copy, NULL);
#endif

    scheme_init_jmpup_buf(b);
  }

  memset(&b->buf, 0, sizeof(mz_jmp_buf));
}

Here is the call graph for this function:

int scheme_setjmpup_relative ( Scheme_Jumpup_Buf b,
void base,
void *volatile  start,
struct Scheme_Cont c 
)

Definition at line 495 of file setjmpup.c.

{
  int local;
  long disguised_b;

#ifdef MZ_USE_JIT
  scheme_flush_stack_cache();
#endif

  FLUSH_REGISTER_WINDOWS;

  if (!(local = scheme_setjmp(b->buf))) {
    if (c) {
      /* We'd like to re-use the stack copied for a continuation
        that encloses the current one --- but we dont' know exactly
        how much the stack is supposed to be shared, since call/cc
        is implemented with a trampoline; certainly, the shallowest
        bit of the old continuation is not right for this one. So,
        we just start from the deepest part of the stack and find
        how many bytes match (using find_same)
        For chains of continuations C1 < C2 < C3, we assume that the 
        discovered-safe part of C1 to be used for C2 is also valid
        for C3, so checking for C3 starts with the fresh part in C2,
        and that's where asymptotic benefits start to kick in. 
         Unfortunately, I can't quite convince myself that this
         assumption is definitely correct. I think it's likely correct,
         but watch out. */
      long same_size;
      START_XFORM_SKIP;
      same_size = find_same(get_copy(c->buf.stack_copy), c->buf.stack_from, c->buf.stack_size);
      b->cont = c;
#ifdef STACK_GROWS_UP
      start = (void *)((char *)c->buf.stack_from + same_size);
#else
      start = (void *)((char *)c->buf.stack_from + (c->buf.stack_size - same_size));
#endif
      /* In 3m-mode, we need `start' on a var-stack boundary: */
      ALIGN_VAR_STACK(__gc_var_stack__, start);
      END_XFORM_SKIP;
    } else
      b->cont = NULL;

    /* In 3m-mode, we need `start' at the end of the frame */
    PAST_VAR_STACK(start);

    /* b is a pointer into the middle of `base', which bad for precise
     gc, so we hide it. */
    disguised_b = (long)b;
    b = NULL;

    scheme_copy_stack((Scheme_Jumpup_Buf *)disguised_b, base, start GC_VAR_STACK_ARG);

    /* Precise GC: ensure that this frame is pushed. */
    if (0) {
      base = scheme_malloc(0);
    }

    return 0;
  }

  return local;
}

Here is the call graph for this function:

void scheme_uncopy_stack ( int  ok,
Scheme_Jumpup_Buf b,
long *  prev 
)

Definition at line 330 of file setjmpup.c.

{
  GC_CAN_IGNORE Scheme_Jumpup_Buf *c;
  long top_delta = 0, bottom_delta = 0, size;
  void *cfrom, *cto;

  if (!ok) {
    unsigned long z;
    long junk[200];

    z = (unsigned long)&junk[0];

    scheme_uncopy_stack(STK_COMP(z, DEEPPOS(b)), b, junk);
  }

  /* Vague attempt to prevent the compiler from optimizing away `prev': */
  prev[199] = 0;

  FLUSH_REGISTER_WINDOWS;

  START_XFORM_SKIP;
  c = b;
  while (c) {
    size = c->stack_size - top_delta;
    cto = (char *)c->stack_from + bottom_delta;
    cfrom = (char *)get_copy(c->stack_copy) + bottom_delta;

    memcpy(cto, cfrom, size);

    if (c->cont) {
#ifdef STACK_GROWS_UP
      top_delta = (((unsigned long)c->cont->buf.stack_from
                  + c->cont->buf.stack_size)
                 - (unsigned long)c->stack_from);
#else
      bottom_delta = ((unsigned long)c->stack_from 
                    + c->stack_size
                    - (unsigned long)c->cont->buf.stack_from);
      top_delta = bottom_delta;
#endif
      c = &c->cont->buf;
    } else
      c = NULL;
  }
  END_XFORM_SKIP;

#ifdef MZ_PRECISE_GC
  GC_variable_stack = b->gc_var_stack;
  if (scheme_set_external_stack_val)
    scheme_set_external_stack_val(b->external_stack);
#endif

  scheme_longjmp(b->buf, 1);
}

Here is the caller graph for this function:

static void set_copy ( void s_c,
void c 
) [static]

Definition at line 203 of file setjmpup.c.

{
  CopiedStack *cs = (CopiedStack *)s_c;

  cs->_stack_copy = c;
}

Here is the caller graph for this function:

static void update_push_copied_stacks ( void  ) [static]

Definition at line 134 of file setjmpup.c.

Here is the call graph for this function:

Here is the caller graph for this function:


Variable Documentation

Definition at line 84 of file setjmpup.c.

Definition at line 1025 of file gc.h.

Definition at line 38 of file finalize.c.

Definition at line 85 of file setjmpup.c.