/* The number of cells from the start of the object which should be scanned by the GC. Some types have a binary payload at the end (string, word, DLL) which we ignore. */ cell factor_vm::binary_payload_start(object *pointer) { switch(pointer->h.hi_tag()) { /* these objects do not refer to other objects at all */ case FLOAT_TYPE: case BYTE_ARRAY_TYPE: case BIGNUM_TYPE: case CALLSTACK_TYPE: return 0; /* these objects have some binary data at the end */ case WORD_TYPE: return sizeof(word) - sizeof(cell) * 3; case ALIEN_TYPE: return sizeof(cell) * 3; case DLL_TYPE: return sizeof(cell) * 2; case QUOTATION_TYPE: return sizeof(quotation) - sizeof(cell) * 2; case STRING_TYPE: return sizeof(string); /* everything else consists entirely of pointers */ case ARRAY_TYPE: return array_size<array>(array_capacity((array*)pointer)); case TUPLE_TYPE: return tuple_size(untag<tuple_layout>(((tuple *)pointer)->layout)); case WRAPPER_TYPE: return sizeof(wrapper); default: critical_error("Invalid header",(cell)pointer); return 0; /* can't happen */ } }
static gint lasso_server_add_provider_helper(LassoServer *server, LassoProviderRole role, const gchar *metadata, const gchar *public_key, const gchar *ca_cert_chain, LassoProvider *(*provider_constructor)(LassoProviderRole role, const char *metadata, const char *public_key, const char *ca_cert_chain)) { LassoProvider *provider; g_return_val_if_fail(LASSO_IS_SERVER(server), LASSO_PARAM_ERROR_BAD_TYPE_OR_NULL_OBJ); g_return_val_if_fail(metadata != NULL, LASSO_PARAM_ERROR_INVALID_VALUE); provider = provider_constructor(role, metadata, public_key, ca_cert_chain); if (provider == NULL) { return critical_error(LASSO_SERVER_ERROR_ADD_PROVIDER_FAILED); } provider->role = role; if (LASSO_PROVIDER(server)->private_data->conformance == LASSO_PROTOCOL_SAML_2_0 && provider->private_data->conformance != LASSO_PROTOCOL_SAML_2_0) { lasso_node_destroy(LASSO_NODE(provider)); return LASSO_SERVER_ERROR_ADD_PROVIDER_PROTOCOL_MISMATCH; } if (LASSO_PROVIDER(server)->private_data->conformance == LASSO_PROTOCOL_LIBERTY_1_2 && provider->private_data->conformance > LASSO_PROTOCOL_LIBERTY_1_2) { lasso_node_destroy(LASSO_NODE(provider)); return LASSO_SERVER_ERROR_ADD_PROVIDER_PROTOCOL_MISMATCH; } g_hash_table_insert(server->providers, g_strdup(provider->ProviderID), provider); return 0; }
/* Allocates memory */ cell factorvm::frame_scan(stack_frame *frame) { switch(frame_type(frame)) { case QUOTATION_TYPE: { cell quot = frame_executing(frame); if(quot == F) return F; else { char *return_addr = (char *)FRAME_RETURN_ADDRESS(frame); char *quot_xt = (char *)(frame_code(frame) + 1); return tag_fixnum(quot_code_offset_to_scan( quot,(cell)(return_addr - quot_xt))); } } case WORD_TYPE: return F; default: critical_error("Bad frame type",frame_type(frame)); return F; } }
void factor_vm::start_gc_again() { end_gc(); switch(current_gc->op) { case collect_nursery_op: current_gc->op = collect_aging_op; break; case collect_aging_op: current_gc->op = collect_to_tenured_op; break; case collect_to_tenured_op: current_gc->op = collect_full_op; break; case collect_full_op: case collect_compact_op: current_gc->op = collect_growing_heap_op; break; default: critical_error("Bad GC op",current_gc->op); break; } current_gc->event = new gc_event(current_gc->op,this); }
static u32 indirect_blocks_needed(u32 len) { u32 ind = 0; if (len <= EXT4_NDIR_BLOCKS) return ind; len -= EXT4_NDIR_BLOCKS; /* We will need an indirect block for the rest of the blocks */ ind += DIV_ROUND_UP(len, aux_info.blocks_per_ind); if (len <= aux_info.blocks_per_ind) return ind; len -= aux_info.blocks_per_ind; ind += DIV_ROUND_UP(len, aux_info.blocks_per_dind); if (len <= aux_info.blocks_per_dind) return ind; len -= aux_info.blocks_per_dind; ind += DIV_ROUND_UP(len, aux_info.blocks_per_tind); if (len <= aux_info.blocks_per_tind) return ind; critical_error("request too large"); return 0; }
/* Size of the data area of an object pointed to by an untagged pointer */ cell factor_vm::unaligned_object_size(object *pointer) { switch(pointer->h.hi_tag()) { case ARRAY_TYPE: return array_size((array*)pointer); case BIGNUM_TYPE: return array_size((bignum*)pointer); case BYTE_ARRAY_TYPE: return array_size((byte_array*)pointer); case STRING_TYPE: return string_size(string_capacity((string*)pointer)); case TUPLE_TYPE: return tuple_size(untag<tuple_layout>(((tuple *)pointer)->layout)); case QUOTATION_TYPE: return sizeof(quotation); case WORD_TYPE: return sizeof(word); case FLOAT_TYPE: return sizeof(boxed_float); case DLL_TYPE: return sizeof(dll); case ALIEN_TYPE: return sizeof(alien); case WRAPPER_TYPE: return sizeof(wrapper); case CALLSTACK_TYPE: return callstack_size(untag_fixnum(((callstack *)pointer)->length)); default: critical_error("Invalid header",(cell)pointer); return 0; /* can't happen */ } }
/* Creates data buffers for the first backing_len bytes of a block allocation and queues them to be written */ static u8 *create_backing(struct block_allocation *alloc, unsigned long backing_len) { if (DIV_ROUND_UP(backing_len, info.block_size) > EXT4_NDIR_BLOCKS) critical_error("indirect backing larger than %d blocks", EXT4_NDIR_BLOCKS); u8 *data = calloc(backing_len, 1); if (!data) critical_error_errno("calloc"); u8 *ptr = data; for (; alloc != NULL && backing_len > 0; get_next_region(alloc)) { u32 region_block; u32 region_len; u32 len; get_region(alloc, ®ion_block, ®ion_len); len = min(region_len * info.block_size, backing_len); queue_data_block(ptr, len, region_block); ptr += len; backing_len -= len; } return data; }
void factor_vm::start_gc_again() { end_gc(); switch(current_gc->op) { case collect_nursery_op: /* Nursery collection can fail if aging does not have enough free space to fit all live objects from nursery. */ current_gc->op = collect_aging_op; break; case collect_aging_op: /* Aging collection can fail if the aging semispace cannot fit all the live objects from the other aging semispace and the nursery. */ current_gc->op = collect_to_tenured_op; break; default: /* Nothing else should fail mid-collection due to insufficient space in the target generation. */ critical_error("Bad GC op",current_gc->op); break; } if(gc_events) current_gc->event = new gc_event(current_gc->op,this); }
cell factor_vm::lookup_tuple_method(cell obj, cell methods) { tuple_layout *layout = untag<tuple_layout>(untag<tuple>(obj)->layout); array *echelons = untag<array>(methods); fixnum echelon = std::min(untag_fixnum(layout->echelon),(fixnum)array_capacity(echelons) - 1); while(echelon >= 0) { cell echelon_methods = array_nth(echelons,echelon); if(tagged<object>(echelon_methods).type_p(WORD_TYPE)) return echelon_methods; else if(to_boolean(echelon_methods)) { cell klass = nth_superclass(layout,echelon); cell hashcode = untag_fixnum(nth_hashcode(layout,echelon)); cell result = search_lookup_hash(echelon_methods,klass,hashcode); if(to_boolean(result)) return result; } echelon--; } critical_error("Cannot find tuple method",methods); return false_object; }
void factor_vm::gc(gc_op op, cell requested_bytes, bool trace_contexts_p) { assert(!gc_off); assert(!current_gc); current_gc = new gc_state(op,this); /* Keep trying to GC higher and higher generations until we don't run out of space */ if(setjmp(current_gc->gc_unwind)) { /* We come back here if a generation is full */ start_gc_again(); } current_gc->event->op = current_gc->op; switch(current_gc->op) { case collect_nursery_op: collect_nursery(); break; case collect_aging_op: collect_aging(); if(data->high_fragmentation_p()) { current_gc->op = collect_full_op; current_gc->event->op = collect_full_op; collect_full(trace_contexts_p); } break; case collect_to_tenured_op: collect_to_tenured(); if(data->high_fragmentation_p()) { current_gc->op = collect_full_op; current_gc->event->op = collect_full_op; collect_full(trace_contexts_p); } break; case collect_full_op: collect_full(trace_contexts_p); break; case collect_compact_op: collect_compact(trace_contexts_p); break; case collect_growing_heap_op: collect_growing_heap(requested_bytes,trace_contexts_p); break; default: critical_error("Bad GC op",current_gc->op); break; } end_gc(); delete current_gc; current_gc = NULL; }
/* return a newly-malloc'd string that is a copy of str. The new string is guaranteed to have a trailing slash. If absolute is true, the new string is also guaranteed to have a leading slash. */ static char *canonicalize_slashes(const char *str, bool absolute) { char *ret; int len = strlen(str); int newlen = len; char *ptr; if (len == 0) { if (absolute) return strdup("/"); else return strdup(""); } if (str[0] != '/' && absolute) { newlen++; } if (str[len - 1] != '/') { newlen++; } ret = malloc(newlen + 1); if (!ret) { critical_error("malloc"); } ptr = ret; if (str[0] != '/' && absolute) { *ptr++ = '/'; } strcpy(ptr, str); ptr += len; if (str[len - 1] != '/') { *ptr++ = '/'; } if (ptr != ret + newlen) { critical_error("assertion failed\n"); } *ptr = '\0'; return ret; }
void factor_vm::primitive_modify_code_heap() { bool reset_inline_caches = to_boolean(ctx->pop()); bool update_existing_words = to_boolean(ctx->pop()); data_root<array> alist(ctx->pop(),this); cell count = array_capacity(alist.untagged()); if(count == 0) return; for(cell i = 0; i < count; i++) { data_root<array> pair(array_nth(alist.untagged(),i),this); data_root<word> word(array_nth(pair.untagged(),0),this); data_root<object> data(array_nth(pair.untagged(),1),this); switch(data.type()) { case QUOTATION_TYPE: jit_compile_word(word.value(),data.value(),false); break; case ARRAY_TYPE: { array *compiled_data = data.as<array>().untagged(); cell parameters = array_nth(compiled_data,0); cell literals = array_nth(compiled_data,1); cell relocation = array_nth(compiled_data,2); cell labels = array_nth(compiled_data,3); cell code = array_nth(compiled_data,4); code_block *compiled = add_code_block( code_block_optimized, code, labels, word.value(), relocation, parameters, literals); word->code = compiled; } break; default: critical_error("Expected a quotation or an array",data.value()); break; } update_word_entry_point(word.untagged()); } if(update_existing_words) update_code_heap_words(reset_inline_caches); else initialize_code_blocks(); }
void inode_attach_resize(struct ext4_inode *inode, struct block_allocation *alloc) { u32 block_len = block_allocation_len(alloc); u32 superblocks = block_len / info.bg_desc_reserve_blocks; u32 i, j; u64 blocks; u64 size; if (block_len % info.bg_desc_reserve_blocks) critical_error("reserved blocks not a multiple of %d", info.bg_desc_reserve_blocks); append_oob_allocation(alloc, 1); u32 dind_block = get_oob_block(alloc, 0); u32 *dind_block_data = calloc(info.block_size, 1); if (!dind_block_data) critical_error_errno("calloc"); queue_data_block((u8 *)dind_block_data, info.block_size, dind_block); u32 *ind_block_data = calloc(info.block_size, info.bg_desc_reserve_blocks); if (!ind_block_data) critical_error_errno("calloc"); queue_data_block((u8 *)ind_block_data, info.block_size * info.bg_desc_reserve_blocks, get_block(alloc, 0)); for (i = 0; i < info.bg_desc_reserve_blocks; i++) { int r = (i - aux_info.bg_desc_blocks) % info.bg_desc_reserve_blocks; if (r < 0) r += info.bg_desc_reserve_blocks; dind_block_data[i] = get_block(alloc, r); for (j = 1; j < superblocks; j++) { u32 b = j * info.bg_desc_reserve_blocks + r; ind_block_data[r * aux_info.blocks_per_ind + j - 1] = get_block(alloc, b); } } u32 last_block = EXT4_NDIR_BLOCKS + aux_info.blocks_per_ind + aux_info.blocks_per_ind * (info.bg_desc_reserve_blocks - 1) + superblocks - 2; blocks = ((u64)block_len + 1) * info.block_size / 512; size = (u64)last_block * info.block_size; inode->i_block[EXT4_DIND_BLOCK] = dind_block; inode->i_flags = 0; inode->i_blocks_lo = blocks; inode->osd2.linux2.l_i_blocks_high = blocks >> 32; inode->i_size_lo = size; inode->i_size_high = size >> 32; }
void writeBNtoFile(const BIGNUM *bn, const char *filename) { int bufLen = BN_num_bytes(bn); unsigned char *buf = (unsigned char *) malloc(bufLen); bufLen = BN_bn2bin(bn, buf); if (_bufToFile(filename, buf, bufLen)) { printf("%s - ",filename); critical_error("can't write to file!"); } free(buf); }
void factor_vm::primitive_set_callstack() { callstack *stack = untag_check<callstack>(dpop()); set_callstack(stack_chain->callstack_bottom, stack->top(), untag_fixnum(stack->length), memcpy); /* We cannot return here ... */ critical_error("Bug in set_callstack()",0); }
/* Called after reading the code heap from the image file, and after code GC. In the former case, we must add a large free block from compiling.base + size to compiling.limit. */ void build_free_list(F_HEAP *heap, CELL size) { F_BLOCK *prev = NULL; F_BLOCK *prev_free = NULL; F_BLOCK *scan = first_block(heap); F_BLOCK *end = (F_BLOCK *)(heap->segment->start + size); /* Add all free blocks to the free list */ while(scan && scan < end) { switch(scan->status) { case B_FREE: update_free_list(heap,prev_free,scan); prev_free = scan; break; case B_ALLOCATED: break; default: critical_error("Invalid scan->status",(CELL)scan); break; } prev = scan; scan = next_block(heap,scan); } /* If there is room at the end of the heap, add a free block. This branch is only taken after loading a new image, not after code GC */ if((CELL)(end + 1) <= heap->segment->end) { end->status = B_FREE; end->next_free = NULL; end->size = heap->segment->end - (CELL)end; /* add final free block */ update_free_list(heap,prev_free,end); } /* This branch is taken if the newly loaded image fits exactly, or after code GC */ else { /* even if there's no room at the end of the heap for a new free block, we might have to jigger it up by a few bytes in case prev + prev->size */ if(prev) prev->size = heap->segment->end - (CELL)prev; /* this is the last free block */ update_free_list(heap,prev_free,NULL); } }
void readBNfromFile(BIGNUM *bn, const char *filename) { unsigned char *buf; int bufLen; if (_fileToBuf(filename, &buf, &bufLen)) { printf("%s - ",filename); critical_error("Can't read from file!"); } BN_bin2bn(buf, bufLen, bn); free(buf); }
/* References to undefined symbols are patched up to call this function on image load. It finds the symbol and library, and throws an error. */ void factor_vm::undefined_symbol() { void *frame = ctx->callstack_top; void *return_address = frame_return_address(frame); code_block *compiled = code->code_block_for_address((cell)return_address); find_symbol_at_address_visitor visitor(this, (cell)return_address); compiled->each_instruction_operand(visitor); if (!to_boolean(visitor.symbol)) critical_error("Can't find RT_DLSYM at return address", (cell)return_address); else general_error(ERROR_UNDEFINED_SYMBOL,visitor.symbol,visitor.library); }
/****** X509 UTILS *********************************************************/ DSA* dsaKeyFromCertFile(char *filename) { X509 *cacert; FILE *fp; if (!(fp = fopen(filename, "r"))) critical_error("Error reading certificate file"); if (!(cacert = PEM_read_X509(fp, NULL, NULL, NULL))) critical_error("Error reading certificate in file"); fclose(fp); EVP_PKEY *ca_pkey = X509_get_pubkey(cacert); DSA* ca_dsa = EVP_PKEY_get1_DSA(ca_pkey); free(ca_pkey); X509_free(cacert); if (ca_dsa == NULL) critical_error("Can't read DSA key from certificate"); return ca_dsa; }
void factor_vm::primitive_modify_code_heap() { gc_root<array> alist(dpop(),this); cell count = array_capacity(alist.untagged()); if(count == 0) return; cell i; for(i = 0; i < count; i++) { gc_root<array> pair(array_nth(alist.untagged(),i),this); gc_root<word> word(array_nth(pair.untagged(),0),this); gc_root<object> data(array_nth(pair.untagged(),1),this); switch(data.type()) { case QUOTATION_TYPE: jit_compile_word(word.value(),data.value(),false); break; case ARRAY_TYPE: { array *compiled_data = data.as<array>().untagged(); cell owner = array_nth(compiled_data,0); cell literals = array_nth(compiled_data,1); cell relocation = array_nth(compiled_data,2); cell labels = array_nth(compiled_data,3); cell code = array_nth(compiled_data,4); code_block *compiled = add_code_block( WORD_TYPE, code, labels, owner, relocation, literals); word->code = compiled; } break; default: critical_error("Expected a quotation or an array",data.value()); break; } update_word_xt(word.value()); } update_code_heap_words(); }
/* Allocate a block of memory from the mark and sweep GC heap */ CELL heap_allot(F_HEAP *heap, CELL size) { F_BLOCK *prev = NULL; F_BLOCK *scan = heap->free_list; size = (size + 31) & ~31; while(scan) { CELL this_size = scan->size - sizeof(F_BLOCK); if(scan->status != B_FREE) critical_error("Invalid block in free list",(CELL)scan); if(this_size < size) { prev = scan; scan = scan->next_free; continue; } /* we found a candidate block */ F_BLOCK *next_free; if(this_size - size <= sizeof(F_BLOCK)) { /* too small to be split */ next_free = scan->next_free; } else { /* split the block in two */ CELL new_size = size + sizeof(F_BLOCK); F_BLOCK *split = (F_BLOCK *)((CELL)scan + new_size); split->status = B_FREE; split->size = scan->size - new_size; split->next_free = scan->next_free; scan->size = new_size; next_free = split; } /* update the free list */ update_free_list(heap,prev,next_free); /* this is our new block */ scan->status = B_ALLOCATED; return (CELL)(scan + 1); } return 0; }
cell factor_vm::compute_xt_address(cell obj) { switch(tagged<object>(obj).type()) { case WORD_TYPE: return (cell)untag<word>(obj)->xt; case QUOTATION_TYPE: return (cell)untag<quotation>(obj)->xt; default: critical_error("Expected word or quotation",obj); return 0; } }
/* References to undefined symbols are patched up to call this function on image load. It finds the symbol and library, and throws an error. */ void factor_vm::undefined_symbol() { stack_frame *frame = innermost_stack_frame(ctx->callstack_bottom, ctx->callstack_top); code_block *compiled = frame_code(frame); cell return_address = (cell)FRAME_RETURN_ADDRESS(frame, this); find_symbol_at_address_visitor visitor(this, return_address); compiled->each_instruction_operand(visitor); if (!to_boolean(visitor.symbol)) critical_error("Can't find RT_DLSYM at return address", return_address); else general_error(ERROR_UNDEFINED_SYMBOL,visitor.symbol,visitor.library); }
int main(int argc, char *argv[]) { int optind; bzero(&glob, sizeof(glob)); glob.demux_dev = DEFAULT_DEMUX_DEV; glob.timeout = DEFAULT_TIMEOUT; glob.input_buffer_size = 1024 * TS_SIZE; argp_parse(&argp, argc, argv, 0, &optind, 0); glob.evb = event_base_new(); if (!glob.evb) critical_error("%s: error allocating memory\n", argv[0]); glob.timeout_ev = evtimer_new(glob.evb, timeout_cb, NULL); if (!glob.timeout_ev) critical_error("%s: error allocating memory\n", argv[0]); reset_timeout(&glob); dev_init(&glob, glob.demux_dev); sdt_pid_init(&glob); eit_pid_init(&glob); event_base_dispatch(glob.evb); output_xmltv(&glob); dev_fini(&glob); sdt_pid_fini(&glob); eit_pid_fini(&glob); evtimer_del(glob.timeout_ev); event_base_free(glob.evb); return EXIT_SUCCESS; }
void *factor_vm::object_xt(cell obj) { switch(tagged<object>(obj).type()) { case WORD_TYPE: return untag<word>(obj)->xt; case QUOTATION_TYPE: return untag<quotation>(obj)->xt; default: critical_error("Expected word or quotation",obj); return NULL; } }
void memory_protection_error(CELL addr, F_STACK_FRAME *native_stack) { if(in_page(addr, ds_bot, 0, -1)) general_error(ERROR_DS_UNDERFLOW,F,F,native_stack); else if(in_page(addr, ds_bot, ds_size, 0)) general_error(ERROR_DS_OVERFLOW,F,F,native_stack); else if(in_page(addr, rs_bot, 0, -1)) general_error(ERROR_RS_UNDERFLOW,F,F,native_stack); else if(in_page(addr, rs_bot, rs_size, 0)) general_error(ERROR_RS_OVERFLOW,F,F,native_stack); else if(in_page(addr, nursery.end, 0, 0)) critical_error("allot_object() missed GC check",0); else if(in_page(addr, gc_locals_region->start, 0, -1)) critical_error("gc locals underflow",0); else if(in_page(addr, gc_locals_region->end, 0, 0)) critical_error("gc locals overflow",0); else if(in_page(addr, extra_roots_region->start, 0, -1)) critical_error("extra roots underflow",0); else if(in_page(addr, extra_roots_region->end, 0, 0)) critical_error("extra roots overflow",0); else general_error(ERROR_MEMORY,allot_cell(addr),F,native_stack); }
void memory_protection_error(cell addr, stack_frame *native_stack) { if(in_page(addr, ds_bot, 0, -1)) general_error(ERROR_DS_UNDERFLOW,F,F,native_stack); else if(in_page(addr, ds_bot, ds_size, 0)) general_error(ERROR_DS_OVERFLOW,F,F,native_stack); else if(in_page(addr, rs_bot, 0, -1)) general_error(ERROR_RS_UNDERFLOW,F,F,native_stack); else if(in_page(addr, rs_bot, rs_size, 0)) general_error(ERROR_RS_OVERFLOW,F,F,native_stack); else if(in_page(addr, nursery.end, 0, 0)) critical_error("allot_object() missed GC check",0); else general_error(ERROR_MEMORY,allot_cell(addr),F,native_stack); }
/* Figure out what kind of type check the PIC needs based on the methods it contains */ cell factor_vm::determine_inline_cache_type(array *cache_entries) { bool seen_hi_tag = false, seen_tuple = false; cell i; for(i = 0; i < array_capacity(cache_entries); i += 2) { cell klass = array_nth(cache_entries,i); /* Is it a tuple layout? */ switch(TAG(klass)) { case FIXNUM_TYPE: { fixnum type = untag_fixnum(klass); if(type >= HEADER_TYPE) seen_hi_tag = true; } break; case ARRAY_TYPE: seen_tuple = true; break; default: critical_error("Expected a fixnum or array",klass); break; } } if(seen_hi_tag && seen_tuple) return PIC_HI_TAG_TUPLE; if(seen_hi_tag && !seen_tuple) return PIC_HI_TAG; if(!seen_hi_tag && seen_tuple) return PIC_TUPLE; if(!seen_hi_tag && !seen_tuple) return PIC_TAG; critical_error("Oops",0); return 0; }
// returns NULL if cert doesn't contain the extension, the commitment C value otherwise BIGNUM *getCommitmentValueFromCert(char *cert_filename) { X509 *cert; FILE *fp; if (!(fp = fopen(cert_filename, "r"))) critical_error("Error reading client certificate file"); if (!(cert = PEM_read_X509(fp, NULL, NULL, NULL))) critical_error("Error reading client certificate in file"); fclose(fp); BIGNUM *toret = NULL; // enable the extension handling (retrieve/print as string) int nid = _commitmentExt_start(); // try to locate extension int extpos = X509_get_ext_by_NID(cert, nid, -1); if (extpos!=-1) { // extension found X509_EXTENSION *ext = X509_get_ext(cert, extpos); toret = _commitmentExt2BN(ext); } X509_free(cert); _commitmentExt_end(); return toret; }
cell factor_vm::compute_relocation(relocation_entry rel, cell index, code_block *compiled) { array *literals = (to_boolean(compiled->literals) ? untag<array>(compiled->literals) : NULL); cell offset = relocation_offset_of(rel) + (cell)compiled->xt(); #define ARG array_nth(literals,index) switch(relocation_type_of(rel)) { case RT_PRIMITIVE: return (cell)primitives[untag_fixnum(ARG)]; case RT_DLSYM: return (cell)get_rel_symbol(literals,index); case RT_IMMEDIATE: return ARG; case RT_XT: return (cell)object_xt(ARG); case RT_XT_PIC: return (cell)word_xt_pic(untag<word>(ARG)); case RT_XT_PIC_TAIL: return (cell)word_xt_pic_tail(untag<word>(ARG)); case RT_HERE: { fixnum arg = untag_fixnum(ARG); return (arg >= 0 ? offset + arg : (cell)(compiled + 1) - arg); } case RT_THIS: return (cell)(compiled + 1); case RT_CONTEXT: return (cell)&ctx; case RT_UNTAGGED: return untag_fixnum(ARG); case RT_MEGAMORPHIC_CACHE_HITS: return (cell)&megamorphic_cache_hits; case RT_VM: return (cell)this + untag_fixnum(ARG); case RT_CARDS_OFFSET: return cards_offset; case RT_DECKS_OFFSET: return decks_offset; default: critical_error("Bad rel type",rel); return 0; /* Can't happen */ } #undef ARG }