steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

VM: Refactor alien.cpp to Factor style

db4
Erik Charlebois 2013-05-11 21:40:43 -04:00
parent 6c919e7d72
commit 22014f092e
1 changed files with 117 additions and 142 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
vm/alien.cpp
View File

@ -1,16 +1,12 @@
#include "master.hpp" #include "master.hpp"
namespace factor namespace factor {
{
/* gets the address of an object representing a C pointer, with the /* gets the address of an object representing a C pointer, with the
intention of storing the pointer across code which may potentially GC. */ intention of storing the pointer across code which may potentially GC. */
char *factor_vm::pinned_alien_offset(cell obj) char* factor_vm::pinned_alien_offset(cell obj) {
{ switch (tagged<object>(obj).type()) {
switch(tagged<object>(obj).type()) case ALIEN_TYPE: {
{
case ALIEN_TYPE:
{
alien* ptr = untag<alien>(obj); alien* ptr = untag<alien>(obj);
if (to_boolean(ptr->expired)) if (to_boolean(ptr->expired))
general_error(ERROR_EXPIRED, obj, false_object); general_error(ERROR_EXPIRED, obj, false_object);
@ -29,21 +25,18 @@ char *factor_vm::pinned_alien_offset(cell obj)
/* make an alien */ /* make an alien */
/* Allocates memory */ /* Allocates memory */
cell factor_vm::allot_alien(cell delegate_, cell displacement) cell factor_vm::allot_alien(cell delegate_, cell displacement) {
{
if (displacement == 0) if (displacement == 0)
return delegate_; return delegate_;
data_root<object> delegate(delegate_, this); data_root<object> delegate(delegate_, this);
data_root<alien> new_alien(allot<alien>(sizeof(alien)), this); data_root<alien> new_alien(allot<alien>(sizeof(alien)), this);
if(delegate.type_p(ALIEN_TYPE)) if (delegate.type_p(ALIEN_TYPE)) {
{
tagged<alien> delegate_alien = delegate.as<alien>(); tagged<alien> delegate_alien = delegate.as<alien>();
displacement += delegate_alien->displacement; displacement += delegate_alien->displacement;
new_alien->base = delegate_alien->base; new_alien->base = delegate_alien->base;
} } else
else
new_alien->base = delegate.value(); new_alien->base = delegate.value();
new_alien->displacement = displacement; new_alien->displacement = displacement;
@ -54,20 +47,17 @@ cell factor_vm::allot_alien(cell delegate_, cell displacement)
} }
/* Allocates memory */ /* Allocates memory */
cell factor_vm::allot_alien(void *address) cell factor_vm::allot_alien(void* address) {
{
return allot_alien(false_object, (cell) address); return allot_alien(false_object, (cell) address);
} }
/* make an alien pointing at an offset of another alien */ /* make an alien pointing at an offset of another alien */
/* Allocates memory */ /* Allocates memory */
void factor_vm::primitive_displaced_alien() void factor_vm::primitive_displaced_alien() {
{
cell alien = ctx->pop(); cell alien = ctx->pop();
cell displacement = to_cell(ctx->pop()); cell displacement = to_cell(ctx->pop());
switch(tagged<object>(alien).type()) switch (tagged<object>(alien).type()) {
{
case BYTE_ARRAY_TYPE: case BYTE_ARRAY_TYPE:
case ALIEN_TYPE: case ALIEN_TYPE:
case F_TYPE: case F_TYPE:
@ -82,26 +72,22 @@ void factor_vm::primitive_displaced_alien()
/* address of an object representing a C pointer. Explicitly throw an error /* address of an object representing a C pointer. Explicitly throw an error
if the object is a byte array, as a sanity check. */ if the object is a byte array, as a sanity check. */
/* Allocates memory (from_unsigned_cell can allocate) */ /* Allocates memory (from_unsigned_cell can allocate) */
void factor_vm::primitive_alien_address() void factor_vm::primitive_alien_address() {
{
ctx->replace(from_unsigned_cell((cell) pinned_alien_offset(ctx->peek()))); ctx->replace(from_unsigned_cell((cell) pinned_alien_offset(ctx->peek())));
} }
/* pop ( alien n ) from datastack, return alien's address plus n */ /* pop ( alien n ) from datastack, return alien's address plus n */
void *factor_vm::alien_pointer() void* factor_vm::alien_pointer() {
{
fixnum offset = to_fixnum(ctx->pop()); fixnum offset = to_fixnum(ctx->pop());
return alien_offset(ctx->pop()) + offset; return alien_offset(ctx->pop()) + offset;
} }
/* define words to read/write values at an alien address */ /* define words to read/write values at an alien address */
#define DEFINE_ALIEN_ACCESSOR(name, type, from, to) \ #define DEFINE_ALIEN_ACCESSOR(name, type, from, to) \
VM_C_API void primitive_alien_##name(factor_vm *parent) \ VM_C_API void primitive_alien_##name(factor_vm * parent) { \
{ \
parent->ctx->push(parent->from(*(type*)(parent->alien_pointer()))); \ parent->ctx->push(parent->from(*(type*)(parent->alien_pointer()))); \
} \ } \
VM_C_API void primitive_set_alien_##name(factor_vm *parent) \ VM_C_API void primitive_set_alien_##name(factor_vm * parent) { \
{ \
type* ptr = (type*)parent->alien_pointer(); \ type* ptr = (type*)parent->alien_pointer(); \
type value = (type) parent->to(parent->ctx->pop()); \ type value = (type) parent->to(parent->ctx->pop()); \
*ptr = value; \ *ptr = value; \
@ -110,8 +96,7 @@ void *factor_vm::alien_pointer()
EACH_ALIEN_PRIMITIVE(DEFINE_ALIEN_ACCESSOR) EACH_ALIEN_PRIMITIVE(DEFINE_ALIEN_ACCESSOR)
/* open a native library and push a handle */ /* open a native library and push a handle */
void factor_vm::primitive_dlopen() void factor_vm::primitive_dlopen() {
{
data_root<byte_array> path(ctx->pop(), this); data_root<byte_array> path(ctx->pop(), this);
path.untag_check(this); path.untag_check(this);
data_root<dll> library(allot<dll>(sizeof(dll)), this); data_root<dll> library(allot<dll>(sizeof(dll)), this);
@ -122,60 +107,52 @@ void factor_vm::primitive_dlopen()
/* look up a symbol in a native library */ /* look up a symbol in a native library */
/* Allocates memory */ /* Allocates memory */
void factor_vm::primitive_dlsym() void factor_vm::primitive_dlsym() {
{
data_root<object> library(ctx->pop(), this); data_root<object> library(ctx->pop(), this);
data_root<byte_array> name(ctx->peek(), this); data_root<byte_array> name(ctx->peek(), this);
name.untag_check(this); name.untag_check(this);
symbol_char* sym = name->data<symbol_char>(); symbol_char* sym = name->data<symbol_char>();
if(to_boolean(library.value())) if (to_boolean(library.value())) {
{
dll* d = untag_check<dll>(library.value()); dll* d = untag_check<dll>(library.value());
if (d->handle == NULL) if (d->handle == NULL)
ctx->replace(false_object); ctx->replace(false_object);
else else
ctx->replace(allot_alien(ffi_dlsym(d, sym))); ctx->replace(allot_alien(ffi_dlsym(d, sym)));
} } else
else
ctx->replace(allot_alien(ffi_dlsym(NULL, sym))); ctx->replace(allot_alien(ffi_dlsym(NULL, sym)));
} }
/* look up a symbol in a native library */ /* look up a symbol in a native library */
/* Allocates memory */ /* Allocates memory */
void factor_vm::primitive_dlsym_raw() void factor_vm::primitive_dlsym_raw() {
{
data_root<object> library(ctx->pop(), this); data_root<object> library(ctx->pop(), this);
data_root<byte_array> name(ctx->peek(), this); data_root<byte_array> name(ctx->peek(), this);
name.untag_check(this); name.untag_check(this);
symbol_char* sym = name->data<symbol_char>(); symbol_char* sym = name->data<symbol_char>();
if(to_boolean(library.value())) if (to_boolean(library.value())) {
{
dll* d = untag_check<dll>(library.value()); dll* d = untag_check<dll>(library.value());
if (d->handle == NULL) if (d->handle == NULL)
ctx->replace(false_object); ctx->replace(false_object);
else else
ctx->replace(allot_alien(ffi_dlsym_raw(d, sym))); ctx->replace(allot_alien(ffi_dlsym_raw(d, sym)));
} } else
else
ctx->replace(allot_alien(ffi_dlsym_raw(NULL, sym))); ctx->replace(allot_alien(ffi_dlsym_raw(NULL, sym)));
} }
/* close a native library handle */ /* close a native library handle */
void factor_vm::primitive_dlclose() void factor_vm::primitive_dlclose() {
{
dll* d = untag_check<dll>(ctx->pop()); dll* d = untag_check<dll>(ctx->pop());
if (d->handle != NULL) if (d->handle != NULL)
ffi_dlclose(d); ffi_dlclose(d);
} }
void factor_vm::primitive_dll_validp() void factor_vm::primitive_dll_validp() {
{
cell library = ctx->peek(); cell library = ctx->peek();
if (to_boolean(library)) if (to_boolean(library))
ctx->replace(tag_boolean(untag_check<dll>(library)->handle != NULL)); ctx->replace(tag_boolean(untag_check<dll>(library)->handle != NULL));
@ -184,10 +161,8 @@ void factor_vm::primitive_dll_validp()
} }
/* gets the address of an object representing a C pointer */ /* gets the address of an object representing a C pointer */
char *factor_vm::alien_offset(cell obj) char* factor_vm::alien_offset(cell obj) {
{ switch (tagged<object>(obj).type()) {
switch(tagged<object>(obj).type())
{
case BYTE_ARRAY_TYPE: case BYTE_ARRAY_TYPE:
return untag<byte_array>(obj)->data<char>(); return untag<byte_array>(obj)->data<char>();
case ALIEN_TYPE: case ALIEN_TYPE: