#include "factor.h" INLINE void* alien_offset(CELL object) { ALIEN *alien; F_ARRAY *array; DISPLACED_ALIEN *d; switch(type_of(object)) { case ALIEN_TYPE: alien = untag_alien_fast(object); if(alien->expired) general_error(ERROR_EXPIRED,object); return alien->ptr; case BYTE_ARRAY_TYPE: array = untag_byte_array_fast(object); return array + 1; case DISPLACED_ALIEN_TYPE: d = untag_displaced_alien_fast(object); return alien_offset(d->alien) + d->displacement; default: type_error(ALIEN_TYPE,object); return (void*)-1; /* can't happen */ } } INLINE void* alien_pointer(void) { F_FIXNUM offset = unbox_signed_cell(); return alien_offset(dpop()) + offset; } void* unbox_alien(void) { return alien_offset(dpop()); } ALIEN* alien(void* ptr) { ALIEN* alien = allot_object(ALIEN_TYPE,sizeof(ALIEN)); alien->ptr = ptr; alien->expired = false; return alien; } void box_alien(void* ptr) { dpush(tag_object(alien(ptr))); } void primitive_alien(void) { void* ptr = (void*)unbox_signed_cell(); maybe_garbage_collection(); box_alien(ptr); } void primitive_displaced_alien(void) { CELL alien; CELL displacement; DISPLACED_ALIEN* d; maybe_garbage_collection(); alien = dpop(); displacement = unbox_unsigned_cell(); d = allot_object(DISPLACED_ALIEN_TYPE,sizeof(DISPLACED_ALIEN)); d->alien = alien; d->displacement = displacement; dpush(tag_object(d)); } void primitive_alien_address(void) { box_unsigned_cell((CELL)alien_offset(dpop())); } void fixup_alien(ALIEN* alien) { alien->expired = true; } void fixup_displaced_alien(DISPLACED_ALIEN* d) { data_fixup(&d->alien); } void collect_displaced_alien(DISPLACED_ALIEN* d) { COPY_OBJECT(d->alien); } #define DEF_ALIEN_SLOT(name,type,boxer) \ void primitive_alien_##name (void) \ { \ box_##boxer (*(type*)alien_pointer()); \ } \ void primitive_set_alien_##name (void) \ { \ type* ptr = alien_pointer(); \ type value = unbox_##boxer (); \ *ptr = value; \ } DEF_ALIEN_SLOT(signed_cell,int,signed_cell) DEF_ALIEN_SLOT(unsigned_cell,CELL,unsigned_cell) DEF_ALIEN_SLOT(signed_8,s64,signed_8) DEF_ALIEN_SLOT(unsigned_8,u64,unsigned_8) DEF_ALIEN_SLOT(signed_4,s32,signed_4) DEF_ALIEN_SLOT(unsigned_4,u32,unsigned_4) DEF_ALIEN_SLOT(signed_2,s16,signed_2) DEF_ALIEN_SLOT(unsigned_2,u16,unsigned_2) DEF_ALIEN_SLOT(signed_1,BYTE,signed_1) DEF_ALIEN_SLOT(unsigned_1,BYTE,unsigned_1) void primitive_alien_value_string(void) { box_c_string(alien_pointer()); }