void register_apply( obj closure )
{
unsigned i;
obj call_ctx;
PUSH_PARTCONT(full_call_done,1);
SET_PARTCONT_REG(0,dynamic_state_reg);
call_ctx = alloc( SLOT(arg_count_reg + 1), vector_class );
gvec_write_init( call_ctx, SLOT(0), closure );
for (i=0; i<arg_count_reg; i++)
{
gvec_write_init( call_ctx, SLOT(i+1), reg_ref(i) );
}
dynamic_state_reg = cons( call_ctx, dynamic_state_reg );
if (bci_trace_flag > 0)
{
fprintf( stdout, "calling: " );
fprinto( stdout, gvec_read(literals_reg,SLOT(2)) );
fprintf( stdout, "\n" );
for (i=0; i<arg_count_reg; i++)
{
printf( " reg[%u] = ", i );
fprinto( stdout, reg_ref(i) );
printf( "\n" );
}
fflush(stdout);
}
}
static obj do_vector_output( void )
{
obj result;
unsigned i;
result = alloc( SLOT(NUM_CLASS_MODES+1), vector_class );
for (i=0; i<NUM_CLASS_MODES; i++)
gvec_write_init( result,
SLOT(i+1),
slurp_queue( &image_modes[i].queue ) );
gvec_write_init( result, SLOT(0), slurp_queue( &used_refs ) );
return result;
}
static obj expanded_state( obj deq, UINT_32 expand_bytes )
{
obj state, len = dequeue_count(deq);
UINT_32 i, j, end, lim;
obj result;
result = alloc( expand_bytes + FXWORDS_TO_RIBYTES(len), vector_class );
state = DEQ_STATE(deq);
j = 0;
i = FXWORDS_TO_RIBYTES(DEQ_FRONT(deq));
end = FXWORDS_TO_RIBYTES(DEQ_BACK(deq));
lim = SIZEOF_PTR(state);
while (i != end)
{
gvec_write_init( result, j, gvec_ref( state, i ) );
j += SLOT(1);
i += SLOT(1);
if (i >= lim)
i = 0;
}
while (expand_bytes > 0)
{
gvec_write_init_non_ptr( result, j, FALSE_OBJ );
j += SLOT(1);
expand_bytes -= SLOT(1);
}
return result;
}
obj vmake_os_error( const char *fn, int num_args, va_list va )
{
int i, e = errno;
obj argv, props;
argv = alloc( SLOT(num_args), vector_class );
for (i=0; i<num_args; i++)
gvec_write_init( argv, SLOT(i), va_arg(va,obj) );
props = cons( cons( lookup_symbol( "stack" ),
make_exception_stack() ),
NIL_OBJ );
return make4( os_error_class,
props,
int2fx(e),
make_string( fn ),
argv );
}
void split_bucket( obj table, obj bucket, obj h, obj k, obj v )
{
int i, di, j, dir_bits, bucket_bits;
obj b, vec;
struct bucket_chain hi, lo;
UINT_32 mask;
dir_bits = fx2int(gvec_read(table,HASHTABLE_DIR_BITS));
vec = gvec_read( table, HASHTABLE_DIRECTORY );
if (EQ(bucket,FALSE_OBJ))
{
bucket = make_bucket( gvec_read( table, HASHTABLE_BUCKET_CLASS ),
dir_bits );
write_dir( vec, h, bucket );
write_bucket_hash( bucket, SLOT(2), h );
write_bucket_key( bucket, SLOT(2), k );
write_bucket_value( bucket, SLOT(2), v );
return;
}
bucket_bits = fx2int(gvec_read(bucket,BUCKET_BITS));
/* grow the hash table's directory if necessary */
if (dir_bits == bucket_bits)
{
UINT_32 i, old_size;
obj old_vec = vec;
old_size = 1<<dir_bits;
dir_bits++;
#ifdef DEBUG_0
printf( "growing directory from %u entries\n", old_size );
#endif /* DEBUG_0 */
vec = alloc( SLOT(2*old_size), vector_class );
for (i=0; i<old_size; i++)
gvec_write_init( vec, SLOT(i),
gvec_read( old_vec, SLOT(i) ) );
for (i=0; i<old_size; i++)
gvec_write_init( vec, SLOT(i + old_size),
gvec_read( old_vec, SLOT(i) ) );
gvec_write_ptr( table, HASHTABLE_DIRECTORY, vec );
gvec_write_non_ptr( table, HASHTABLE_DIR_BITS, int2fx(dir_bits) );
}
/* initialize the structures for the new chains */
#ifdef DEBUG_0
printf( "initializing hi/lo\n" );
#endif /* DEBUG_0 */
init_chain( table, &hi, bucket_bits+1 );
init_chain( table, &lo, bucket_bits+1 );
/* traverse the bucket */
/* this mask selects the bit that distinguishes the "hi"
bucket from the "lo" bucket
*/
mask = VAL(int2fx(1)) << bucket_bits;
#ifdef DEBUG_0
printf( "mask = %#x\n", mask );
#endif /* DEBUG_0 */
chain_insert( (VAL(h) & mask) ? &hi : &lo, h, k, v );
for (b=bucket; !EQ(b,FALSE_OBJ); b=gvec_read(b,BUCKET_OVERFLOW))
{
for (i=SLOT(2); i<SLOT(2+BUCKET_CAPACITY); i+=SLOT(1))
{
obj h = gvec_read( b, i );
struct bucket_chain *use;
use = (VAL(h) & mask) ? &hi : &lo;
chain_insert( use,
h,
gvec_read( b, i+SLOT(BUCKET_CAPACITY) ),
gvec_read( b, i+2*SLOT(BUCKET_CAPACITY) ) );
}
}
/* install the new bucket chains in the directory */
i = SLOT( fx2int( h ) & ((1 << bucket_bits) - 1) );
di = SLOT( 1 << bucket_bits );
for (j=0; j<(1<<(dir_bits - (bucket_bits+1))); j++)
{
#ifdef DEBUG_0
printf( "installing lo at %u\n", i/W );
#endif /* DEBUG_0 */
gvec_write( vec, i, lo.first );
i += di;
#ifdef DEBUG_0
printf( "installing hi at %u\n", i/W );
#endif /* DEBUG_0 */
gvec_write( vec, i, hi.first );
i += di;
}
}
