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; } }