/* gets the address of an object representing a C pointer, with the
intention of storing the pointer across code which may potentially GC. */
void *pinned_alien_offset(CELL object)
{
F_ALIEN *alien;
switch(type_of(object))
{
case ALIEN_TYPE:
alien = untag_object(object);
if(alien->expired != F)
general_error(ERROR_EXPIRED,object,F,NULL);
return pinned_alien_offset(alien->alien) + alien->displacement;
case F_TYPE:
return NULL;
default:
type_error(ALIEN_TYPE,object);
return NULL; /* can't happen */
}
}
/* Allocates memory */
void factor_vm::primitive_retainstack_for() {
context* other_ctx = (context*)pinned_alien_offset(ctx->peek());
ctx->replace(retainstack_to_array(other_ctx));
}
void factor_vm::primitive_context_object_for() {
context* other_ctx = (context*)pinned_alien_offset(ctx->pop());
fixnum n = untag_fixnum(ctx->peek());
ctx->replace(other_ctx->context_objects[n]);
}
// address of an object representing a C pointer. Explicitly throw an error
// if the object is a byte array, as a sanity check.
// Allocates memory (from_unsigned_cell can allocate)
void factor_vm::primitive_alien_address() {
ctx->replace(from_unsigned_cell((cell)pinned_alien_offset(ctx->peek())));
}
/* address of an object representing a C pointer. Explicitly throw an error
if the object is a byte array, as a sanity check. */
void factor_vm::primitive_alien_address()
{
ctx->push(allot_cell((cell)pinned_alien_offset(ctx->pop())));
}
void factor_vm::primitive_datastack_for()
{
context *other_ctx = (context *)pinned_alien_offset(ctx->pop());
ctx->push(datastack_to_array(other_ctx));
}
void factor_vm::primitive_callstack_for()
{
context *other_ctx = (context *)pinned_alien_offset(ctx->pop());
ctx->push(capture_callstack(other_ctx));
}
/* address of an object representing a C pointer. Explicitly throw an error
if the object is a byte array, as a sanity check. */
inline void factorvm::vmprim_alien_address()
{
box_unsigned_cell((cell)pinned_alien_offset(dpop()));
}
