/* Allocates memory */
F_COMPILED *compile_profiling_stub(F_WORD *word)
{
CELL literals = allot_array_1(tag_object(word));
REGISTER_ROOT(literals);
F_ARRAY *quadruple = untag_object(userenv[JIT_PROFILING]);
CELL code = array_nth(quadruple,0);
REGISTER_ROOT(code);
F_REL rel;
rel.type = to_fixnum(array_nth(quadruple,2)) | (to_fixnum(array_nth(quadruple,1)) << 8);
rel.offset = to_fixnum(array_nth(quadruple,3)) * compiled_code_format();
F_BYTE_ARRAY *relocation = allot_byte_array(sizeof(F_REL));
memcpy((void *)BREF(relocation,0),&rel,sizeof(F_REL));
UNREGISTER_ROOT(code);
UNREGISTER_ROOT(literals);
return add_compiled_block(
WORD_TYPE,
untag_object(code),
NULL, /* no labels */
tag_object(relocation),
untag_object(literals));
}
void primitive_fread(void)
{
FILE* file = unbox_alien();
CELL size = unbox_array_size();
if(size == 0)
{
dpush(tag_object(allot_string(0,0)));
return;
}
F_BYTE_ARRAY *buf = allot_byte_array(size);
for(;;)
{
int c = fread(buf + 1,1,size,file);
if(c <= 0)
{
if(feof(file))
{
dpush(F);
break;
}
else
io_error();
}
else
{
if(c != size)
{
REGISTER_UNTAGGED(buf);
F_BYTE_ARRAY *new_buf = allot_byte_array(c);
UNREGISTER_UNTAGGED(buf);
memcpy(new_buf + 1, buf + 1,c);
buf = new_buf;
}
dpush(tag_object(buf));
break;
}
}
}
string* factor_vm::reallot_string(string *str_, cell capacity)
{
data_root<string> str(str_,this);
if(reallot_string_in_place_p(str.untagged(),capacity))
{
str->length = tag_fixnum(capacity);
if(to_boolean(str->aux))
{
byte_array *aux = untag<byte_array>(str->aux);
aux->capacity = tag_fixnum(capacity * 2);
}
return str.untagged();
}
else
{
cell to_copy = string_capacity(str.untagged());
if(capacity < to_copy)
to_copy = capacity;
data_root<string> new_str(allot_string_internal(capacity),this);
memcpy(new_str->data(),str->data(),to_copy);
if(to_boolean(str->aux))
{
byte_array *new_aux = allot_byte_array(capacity * sizeof(u16));
new_str->aux = tag<byte_array>(new_aux);
write_barrier(&new_str->aux);
byte_array *aux = untag<byte_array>(str->aux);
memcpy(new_aux->data<u16>(),aux->data<u16>(),to_copy * sizeof(u16));
}
fill_string(new_str.untagged(),to_copy,capacity,'\0');
return new_str.untagged();
}
}
void factor_vm::primitive_byte_array()
{
cell size = unbox_array_size();
ctx->push(tag<byte_array>(allot_byte_array(size)));
}
/* for FFI callbacks receiving structs by value */
void box_value_struct(void *src, CELL size)
{
F_BYTE_ARRAY *array = allot_byte_array(size);
memcpy(array + 1,src,size);
dpush(tag_object(array));
}
/* for FFI callbacks receiving structs by value */
void factorvm::box_value_struct(void *src, cell size)
{
byte_array *bytes = allot_byte_array(size);
memcpy(bytes->data<void>(),src,size);
dpush(tag<byte_array>(bytes));
}
inline void factorvm::vmprim_byte_array()
{
cell size = unbox_array_size();
dpush(tag<byte_array>(allot_byte_array(size)));
}
