static void assert2_pair_addresses_mapped( msgc_context_t *context, word w )
{
{
#ifndef NDEBUG2
if (isptr(pair_cdr(w)) &&
! gc_is_address_mapped( context->gc,
ptrof(pair_cdr(w)), FALSE )) {
gc_is_address_mapped( context->gc, ptrof(pair_cdr(w)), TRUE );
consolemsg("unmapped address, pair 0x%08x in gen %d, cdr = 0x%08x",
w, gen_of(w), pair_cdr(w));
consolemsg("(gno count: %d)", context->gc->gno_count);
assert2(0);
}
if (isptr(pair_car(w)) &&
! gc_is_address_mapped( context->gc,
ptrof(pair_car(w)), FALSE )) {
gc_is_address_mapped( context->gc, ptrof(pair_car(w)), TRUE );
consolemsg("unmapped address, pair 0x%08x in gen %d, car = 0x%08x",
w, gen_of(w), pair_car(w));
consolemsg("(gno count: %d)", context->gc->gno_count);
assert2(0);
}
#endif
}
}
/* NOTE: A copy of this code exists in Sparc/memory.s; if you change
* anything here, check that code as well.
*/
int stk_restore_frame( word *globals )
{
word *stktop, *hframe, *p;
word retoffs, proc, codeaddr, codeptr, header;
unsigned size;
assert2(globals[ G_STKP ] == globals[ G_STKBOT ]);
hframe = ptrof( globals[ G_CONT ] );
size = roundup8( sizefield( *hframe ) + 4 ); /* bytes to copy */
stktop = (word*)globals[ G_STKP ];
stktop -= size / 4;
if (stktop < (word*)globals[ G_ETOP ]) {
supremely_annoyingmsg( "Failed to create stack." );
return 0;
}
globals[ G_STKP ] = (word)stktop;
globals[ G_STKUFLOW ] += 1;
#if 0
annoyingmsg("Restore: %d", size);
#endif
/* copy the frame onto the stack */
p = stktop;
while (size) {
*p++ = *hframe++;
*p++ = *hframe++;
size -= 8;
}
/* Follow continuation chain. */
globals[ G_CONT ] = *(stktop+STK_DYNLINK);
header = *(stktop+HC_HEADER);
retoffs = *(stktop+HC_RETOFFSET);
proc = *(stktop+HC_PROC);
/* convert the header back to a fixnum */
*(stktop+STK_CONTSIZE) = sizefield(header);
/* convert the return address */
if (proc != 0) {
codeptr = *(ptrof( proc )+PROC_CODEPTR);
if (tagof( codeptr ) == BVEC_TAG) {
codeaddr = (word)ptrof( codeptr );
*(stktop+STK_RETADDR) = (codeaddr+4)+retoffs;
} else {
*(stktop+STK_RETADDR) = retoffs;
}
} else {
*(stktop+STK_RETADDR) = retoffs;
}
return 1;
}
void msgc_unmark_object( msgc_context_t *context, word obj )
{
word bit_idx, word_idx;
assert2( context->lowest_heap_address <= ptrof( obj ) &&
ptrof( obj ) < context->highest_heap_address );
my_unmark_object( context, obj );
}
void msgc_mark_object( msgc_context_t *context, word obj )
{
word bit_idx, word_idx;
assert2( context->lowest_heap_address <= ptrof( obj ) &&
ptrof( obj ) < context->highest_heap_address );
bit_idx = (obj - (word)context->lowest_heap_address) >> BIT_IDX_SHIFT;
word_idx = bit_idx >> BITS_TO_WORDS;
context->bitmap[ word_idx ] |= 1 << (bit_idx & BIT_IN_WORD_MASK);
}
bool msgc_object_marked_p( msgc_context_t *context, word obj )
{
word bit_idx, word_idx, bit;
assert2( isptr( obj ) );
assert2( context->lowest_heap_address <= ptrof( obj ) &&
ptrof( obj ) < context->highest_heap_address );
bit_idx = (obj - (word)context->lowest_heap_address) >> BIT_IDX_SHIFT;
word_idx = bit_idx >> BITS_TO_WORDS;
bit = 1 << (bit_idx & BIT_IN_WORD_MASK);
return (context->bitmap[ word_idx ] & bit);
}
static void assert2_root_address_mapped( msgc_context_t *context, word *loc )
{
#ifndef NDEBUG2
if (isptr(*loc) &&
! gc_is_address_mapped( context->gc, ptrof(*loc), FALSE )) {
assert2(0);
}
#endif
}
static void assert2_los_addresses_mapped( msgc_context_t *context, word obj,
int k, int next )
{
#ifndef NDEBUG2
int i;
for ( i=0 ; i < k ; i++ ) {
if (isptr(vector_ref(obj, i+next)) &&
! gc_is_address_mapped( context->gc,
ptrof(vector_ref(obj, i+next)), FALSE )) {
assert( gc_is_address_mapped( context->gc, ptrof(obj), TRUE ));
consolemsg("unmapped address, los vector 0x%08x in gen %d, elem [%d] = 0x%08x",
obj, gen_of(obj), i+next, vector_ref(obj, i+next ));
consolemsg("(gno count: %d)", context->gc->gno_count);
assert2(0);
}
}
#endif
}
/* Single stepping. Takes a fixnum argument which is the constant vector
* index at which to find a string. G_REG0 must be valid.
*/
void C_singlestep( word cidx )
{
char buf[ 300 ];
int l;
word s;
word constvec;
in_noninterruptible_syscall = 1;
constvec = *( ptrof( globals[G_REG0] ) + 2 );
s = *( ptrof( constvec ) + VEC_HEADER_WORDS + nativeint(cidx) );
if (tagof( s ) != BVEC_TAG)
panic_exit( "Internal: Bad arg to C_singlestep().\n" );
l = string_length( s );
strncpy( buf, string_data( s ), min( l, sizeof( buf )-1 ) );
buf[ l ] = 0;
hardconsolemsg( "Step: %s", buf );
localdebugger();
in_noninterruptible_syscall = 0;
}
/* Returns TRUE iff untagged_w was already in ebmp */
bool extbmp_add_elem( extbmp_t *ebmp, word untagged_w )
{ /* ebmp := ebmp U { untagged_w } */
leaf_t *leaf;
word first, lim;
word entry_word;
bool retval;
unsigned int bit_idx, word_idx, bit_in_word;
assert( tagof(untagged_w) == 0 );
first = 0xFFFFFFF;
lim = 0x0;
find_or_alloc_leaf( ebmp, untagged_w, &leaf, &first );
lim = leaf_wordaddr_lim( ebmp, first );
assert( first <= untagged_w );
assert( untagged_w < lim );
bit_idx = (untagged_w - first) >> BIT_IDX_SHIFT;
word_idx = bit_idx >> BIT_IDX_TO_WORDADDR;
bit_in_word = 1 << (bit_idx & BIT_IN_WORD_MASK);
#if 0
if ( ! (bit_in_word & leaf->bitmap[ word_idx ] ))
consolemsg(" extbmp_add_elem new elem: 0x%08x (%d) mhdr:0x%08x",
untagged_w, gen_of(untagged_w), *(ptrof(untagged_w)) );
#endif
entry_word = leaf->bitmap[ word_idx ];
retval = entry_word & bit_in_word;
entry_word |= bit_in_word;
leaf->bitmap[ word_idx ] = entry_word;
assert2( extbmp_is_member(ebmp, untagged_w ));
{
int gno;
gno = gen_of( untagged_w );
assert( gno != 0 );
if (leaf->gno == 0) {
/* mixed leaf; do nothing */
} else if (leaf->gno < 0) {
insert_leaf_in_list( ebmp, leaf, gno );
} else if (leaf->gno != gno) {
move_leaf_to_mixed_list( ebmp, leaf, gno );
}
}
return retval;
}
static void assert2_address_mapped( msgc_context_t *context, word obj )
{
#ifndef NDEBUG2
if (! yh_is_address_mapped( context->gc->young_area, ptrof(obj) ) &&
! los_is_address_mapped( context->gc->los, ptrof(obj), FALSE ) &&
! sh_is_address_mapped( context->gc->static_area, ptrof(obj), FALSE )) {
assert( gc_is_address_mapped( context->gc, ptrof(obj), TRUE ));
assert( yh_is_address_mapped( context->gc->young_area, ptrof(obj) ) ||
los_is_address_mapped( context->gc->los, ptrof(obj), TRUE ) ||
sh_is_address_mapped( context->gc->static_area, ptrof(obj), TRUE ));
}
#endif
}
int stk_size_for_top_stack_frame( word *globals )
{
#if OLD_GC_CODE
return
nativeint( *(word*)globals[ G_STKP ] )*sizeof( word ) + STACK_BASE_SIZE;
#else
int frame_size;
if (globals[ G_STKP ] == globals[ G_STKBOT])
frame_size = sizefield( *ptrof( globals[ G_CONT ] ) );
else
frame_size = *((word*)globals[ G_STKP ] + STK_CONTSIZE);
return roundup8( frame_size + 4 ) + STACK_BASE_SIZE;
#endif
}
static void assert2_object_contents_mapped( msgc_context_t *context, word w,
int n )
{
#ifndef NDEBUG2
int i;
for ( i=0 ; i < n ; i++ ) {
if (isptr(vector_ref( w, i )) &&
! gc_is_address_mapped( context->gc,
ptrof(vector_ref( w, i )), FALSE )) {
consolemsg("unmapped address, vector 0x%08x in gen %d, elem [%d] = 0x%08x",
w, gen_of( w ), i, vector_ref( w, i ));
consolemsg("(gno count: %d)", context->gc->gno_count);
assert2(0);
}
}
#endif
}
static void assert2_tag_hdr_consistency( msgc_context_t *context, word w )
{
#ifndef NDEBUG2
switch (tagof(w)) {
case VEC_TAG:
if (!(ishdr(*ptrof(w)) && header(*ptrof(w)) == header(VEC_HDR) )) {
consolemsg("VEC w: 0x%08x *ptrof(w): 0x%08x ishdr: %s header(*ptrof(w)): %x", w, *ptrof(w), ishdr(*ptrof(w))?"TRUE":"FALSE", header(*ptrof(w)));
}
assert( ishdr(*ptrof(w)) && header(*ptrof(w)) == header(VEC_HDR) );
break;
case PROC_TAG:
if (!( ishdr(*ptrof(w)) && header(*ptrof(w)) == header(PROC_HDR) )) {
consolemsg("PROC w: 0x%08x *ptrof(w): 0x%08x ishdr: %s header(*ptrof(w)): %x", w, *ptrof(w), ishdr(*ptrof(w))?"TRUE":"FALSE", header(*ptrof(w)));
}
assert( ishdr(*ptrof(w)) && header(*ptrof(w)) == header(PROC_HDR) );
break;
}
#endif
}
static bool fill_from_los_stack( msgc_context_t *context )
{
int next, k, n, i;
word obj;
if (context->los_stack.stkp == context->los_stack.stkbot) {
/* underflow */
if (!pop_segment( &context->los_stack ))
return FALSE;
}
obj = *--context->los_stack.stkp;
next = (int)*--context->los_stack.stkp;
n = bytes2words( sizefield( *ptrof(obj) ) );
k = min( n-next, LARGE_OBJECT_LIMIT );
for ( i=0 ; i < k ; i++ )
PUSH( context, vector_ref( obj, i+next ) );
if (next+k < n)
LOS_PUSH( context, next+k, obj );
return TRUE;
}
static void assert2_basic_invs( msgc_context_t *context, word src, word obj )
{
#ifndef NDEBUG2
word TMP = obj;
if (isptr(TMP)) {
gc_check_remset_invs( context->gc, src, obj );
assert2( (context)->lowest_heap_address <= ptrof(TMP) );
assert2( ptrof(TMP) < (context)->highest_heap_address );
if (! gc_is_address_mapped( context->gc, ptrof(TMP), FALSE )) {
assert2(gc_is_address_mapped( context->gc, ptrof(TMP), TRUE ));
}
if (tagof(TMP) == PAIR_TAG) {
/* no header on pairs... */
} else if (tagof(TMP) == VEC_TAG) {
assert2(ishdr(*ptrof(TMP)));
assert2(header(*ptrof(TMP)) == header(VEC_HDR));
} else if (tagof(TMP) == PROC_TAG) {
assert2(ishdr(*ptrof(TMP)));
assert2(header(*ptrof(TMP)) == header(PROC_HDR));
}
}
#endif
}
static void PUSH( msgc_context_t *context, word obj, word src, int word_offset ) {
word TMP = obj;
assert((word_offset < 0) || (ptrof(src)[word_offset] == obj));
assert2_basic_invs( context, src, obj );
if ((context)->object_visitor != NULL) {
(context)->object_visitor_data =
(context)->object_visitor
( obj, src, word_offset*sizeof(word), (context)->object_visitor_data );
}
if (((context)->stop_when != NULL) && !((context)->signal_stop)) {
if ((context)->stop_when(obj, src, (context)->stop_when_data)) {
(context)->signal_stop = TRUE;
(context)->stopped_on_obj = obj;
(context)->stopped_on_src = src;
}
}
if (isptr(TMP)) {
if ((context)->stack.stkp == (context)->stack.stklim)
push_segment( &((context)->stack) );
*((context)->stack.stkp++) = TMP;
}
}
static int push_constituents( msgc_context_t *context, word w )
{
int i, n;
switch (tagof(w)) {
case PAIR_TAG :
PUSH( context, pair_cdr( w ) ); /* Do the CDR last */
PUSH( context, pair_car( w ) ); /* Do the CAR first */
return 2;
case VEC_TAG :
case PROC_TAG :
n = bytes2words( sizefield(*ptrof(w)) );
if (n > LARGE_OBJECT_LIMIT)
LOS_PUSH( context, 0, w ); /* Treat large objects specially */
else
for ( i=0 ; i < n ; i++ )
PUSH( context, vector_ref( w, i ) );
return n+1;
default :
return 0;
}
}
static int push_constituents( msgc_context_t *context, word w )
{
int i, n;
switch (tagof(w)) {
case PAIR_TAG :
return push_pair_constiuents( context, w );
case VEC_TAG :
case PROC_TAG :
assert2_tag_hdr_consistency( context, w );
n = bytes2words( sizefield(*ptrof(w)) );
if (n > LARGE_OBJECT_LIMIT)
LOS_PUSH( context, 0, w ); /* Treat large objects specially */
else {
assert2_object_contents_mapped( context, w, n );
for ( i=0 ; i < n ; i++ ) {
PUSH( context, vector_ref( w, i ), w, i+1 );
}
}
return n+1;
default :
return 0;
}
}
void scheme_start( word *globals )
{
cont_t f = 0;
word *stkp = (word*)globals[ G_STKP ];
int x;
jmp_buf *old_jump_buffer = dispatch_jump_buffer;
if (already_running)
annoyingmsg( "Recursive call to scheme_start (FFI?)" );
already_running = 1;
dispatch_jump_buffer = gclib_alloc_rts(sizeof(jmp_buf), 0);
if (dispatch_jump_buffer == NULL)
panic_abort("Couldn't allocate fresh jmp_buf");
#if 0
/* Patch in bootstrap code if necessary */
if (procedure_ref( globals[ G_REG0 ], IDX_PROC_CODE ) == FALSE_CONST)
procedure_set( globals[ G_REG0 ], IDX_PROC_CODE, (word)twobit_start );
#endif
/* Return address for bottom-most frame */
stkp[ STK_RETADDR ] = (word)i386_dispatch_loop_return;
stkp[ STK_REG0 ] = 0;
/* The dispatch loop is a doubly-nested quasi-loop.
The outer loop uses setjmp/longjmp for control and is entered but
rarely; most of the time is spent in the inner loop. The job of
the outer loop is to provide the inner loop with the address of
the first block to execute.
The inner loop is implemented entirely in compiled code: we just
jump to the entry point, and any return is done through a longjmp
to the outer loop.
*/
/* Outer loop */
switch (x = setjmp( *dispatch_jump_buffer )) {
case 0 :
case DISPATCH_CALL_R0 :
assert2( tagof( globals[ G_REG0 ]) == PROC_TAG );
f = procedure_ref( globals[ G_REG0 ], IDX_PROC_CODE );
f = (cont_t)(ptrof(f)+1); /* skip over bytevector header */
break;
case DISPATCH_EXIT:
already_running = 0;
gclib_free(dispatch_jump_buffer, sizeof(jmp_buf));
dispatch_jump_buffer = old_jump_buffer;
return;
case DISPATCH_RETURN_FROM_S2S_CALL :
panic_exit( "DISPATCH_RETURN_FROM_S2S_CALL shouldn't happen." );
break;
case DISPATCH_STKUFLOW :
f = refill_stack_cache( globals );
globals[ G_STKP ] += 4+4*STK_RETADDR; /* The '4*' compensates for layouts.cfg oversight */
break;
case DISPATCH_SIGFPE :
handle_sigfpe( globals );
panic_exit( "handle_sigfpe() returned." );
default :
panic_exit( "Unexpected value %d from setjmp in scheme_start()", x );
}
/* Inner loop */
i386_scheme_jump(globals,f); /* Never returns */
}
bool msgc_object_in_domain( msgc_context_t *context, word obj )
{
return ( context->lowest_heap_address <= ptrof( obj ) &&
ptrof( obj ) < context->highest_heap_address );
}
void stk_flush( word *globals )
{
word *stktop, *stkbot, *first, *prev;
word retaddr, codeaddr, codeptr, proc, size;
unsigned framecount;
assert2( tagof( globals[ G_REG0 ]) == PROC_TAG );
stktop = (word*)globals[ G_STKP ];
stkbot = (word*)globals[ G_STKBOT ];
stack_state.words_flushed += (stkbot-stktop);
first = prev = 0;
framecount = 0;
while (stktop < stkbot) {
size = *(stktop+STK_CONTSIZE);
retaddr = *(stktop+STK_RETADDR);
/* convert header to vector header */
assert2( size % 4 == 0 ); /* size must be words, a fixnum */
assert2( (s_word)size >= 12 ); /* 3-word minimum, and nonnegative */
*(stktop+HC_HEADER) = mkheader( size, VEC_HDR );
/* convert return address */
proc = *(stktop+STK_REG0);
if (proc != 0) {
assert2( tagof( proc ) == PROC_TAG );
codeptr = *(ptrof( proc )+PROC_CODEPTR);
if (tagof( codeptr ) == BVEC_TAG) {
codeaddr = (word)ptrof( codeptr );
*(stktop+HC_RETOFFSET) = retaddr-(codeaddr+4);
} else {
*(stktop+HC_RETOFFSET) = retaddr;
}
} else {
*(stktop+HC_RETOFFSET) = retaddr;
}
/* chain things together */
if (first == 0)
first = stktop;
else
*(prev+HC_DYNLINK) = (word)tagptr( stktop, VEC_TAG );
prev = stktop;
framecount++;
size = roundup8( size+4 );
stktop += size / 4;
#if 0
annoyingmsg("Flush: %d", size );
#endif
}
if (prev != 0)
*(prev+HC_DYNLINK) = globals[ G_CONT ];
if (first != 0)
globals[ G_CONT ] = (word)tagptr( first, VEC_TAG );
globals[ G_STKBOT ] = globals[ G_STKP ];
stack_state.frames_flushed += framecount;
}
static word strip_tag( word w ) {
return (word)ptrof(w);
}