/* 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
}
