]> gitweb.factorcode.org Git - factor.git/blobdiff - vm/alien.cpp
Put brackets around ipv6 addresses in `inet6 present`
[factor.git] / vm / alien.cpp
index b0005865310057c59119df5eb4db7be873163219..8b6cc81b765b00773931de952ad205479be4087b 100644 (file)
@@ -2,29 +2,28 @@
 
 namespace factor {
 
-/* gets the address of an object representing a C pointer, with the
-intention of storing the pointer across code which may potentially GC. */
+// gets the address of an object representing a C pointer, with the
+// intention of storing the pointer across code which may potentially GC.
 char* factor_vm::pinned_alien_offset(cell obj) {
-  switch (tagged<object>(obj).type()) {
+  switch (TAG(obj)) {
     case ALIEN_TYPE: {
       alien* ptr = untag<alien>(obj);
       if (to_boolean(ptr->expired))
         general_error(ERROR_EXPIRED, obj, false_object);
       if (to_boolean(ptr->base))
         type_error(ALIEN_TYPE, obj);
-      else
-        return (char*)ptr->address;
+      return (char*)ptr->address;
     }
     case F_TYPE:
       return NULL;
     default:
       type_error(ALIEN_TYPE, obj);
-      return NULL; /* can't happen */
+      return NULL; // can't happen
   }
 }
 
-/* make an alien */
-/* Allocates memory */
+// make an alien
+// Allocates memory
 cell factor_vm::allot_alien(cell delegate_, cell displacement) {
   if (displacement == 0)
     return delegate_;
@@ -32,7 +31,7 @@ cell factor_vm::allot_alien(cell delegate_, cell displacement) {
   data_root<object> delegate(delegate_, this);
   data_root<alien> new_alien(allot<alien>(sizeof(alien)), this);
 
-  if (delegate.type_p(ALIEN_TYPE)) {
+  if (TAG(delegate_) == ALIEN_TYPE) {
     tagged<alien> delegate_alien = delegate.as<alien>();
     displacement += delegate_alien->displacement;
     new_alien->base = delegate_alien->base;
@@ -46,18 +45,18 @@ cell factor_vm::allot_alien(cell delegate_, cell displacement) {
   return new_alien.value();
 }
 
-/* Allocates memory */
-cell factor_vm::allot_alien(void* address) {
-  return allot_alien(false_object, (cell)address);
+// Allocates memory
+cell factor_vm::allot_alien(cell address) {
+  return allot_alien(false_object, address);
 }
 
-/* make an alien pointing at an offset of another alien */
-/* Allocates memory */
+// make an alien pointing at an offset of another alien
+// Allocates memory
 void factor_vm::primitive_displaced_alien() {
   cell alien = ctx->pop();
   cell displacement = to_cell(ctx->pop());
 
-  switch (tagged<object>(alien).type()) {
+  switch (TAG(alien)) {
     case BYTE_ARRAY_TYPE:
     case ALIEN_TYPE:
     case F_TYPE:
@@ -69,20 +68,20 @@ void factor_vm::primitive_displaced_alien() {
   }
 }
 
-/* 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) */
+// 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())));
 }
 
-/* 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() {
   fixnum offset = to_fixnum(ctx->pop());
   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)                     \
   VM_C_API void primitive_alien_##name(factor_vm * parent) {            \
     parent->ctx->push(parent->from(*(type*)(parent->alien_pointer()))); \
@@ -95,22 +94,23 @@ void* factor_vm::alien_pointer() {
 
 EACH_ALIEN_PRIMITIVE(DEFINE_ALIEN_ACCESSOR)
 
-/* open a native library and push a handle */
+// open a native library and push a handle
+// Allocates memory
 void factor_vm::primitive_dlopen() {
   data_root<byte_array> path(ctx->pop(), this);
-  path.untag_check(this);
+  check_tagged(path);
   data_root<dll> library(allot<dll>(sizeof(dll)), this);
   library->path = path.value();
   ffi_dlopen(library.untagged());
   ctx->push(library.value());
 }
 
-/* look up a symbol in a native library */
-/* Allocates memory */
+// look up a symbol in a native library
+// Allocates memory
 void factor_vm::primitive_dlsym() {
   data_root<object> library(ctx->pop(), this);
   data_root<byte_array> name(ctx->peek(), this);
-  name.untag_check(this);
+  check_tagged(name);
 
   symbol_char* sym = name->data<symbol_char>();
 
@@ -125,12 +125,12 @@ void factor_vm::primitive_dlsym() {
     ctx->replace(allot_alien(ffi_dlsym(NULL, sym)));
 }
 
-/* look up a symbol in a native library */
-/* Allocates memory */
+// look up a symbol in a native library
+// Allocates memory
 void factor_vm::primitive_dlsym_raw() {
   data_root<object> library(ctx->pop(), this);
   data_root<byte_array> name(ctx->peek(), this);
-  name.untag_check(this);
+  check_tagged(name);
 
   symbol_char* sym = name->data<symbol_char>();
 
@@ -145,7 +145,7 @@ void factor_vm::primitive_dlsym_raw() {
     ctx->replace(allot_alien(ffi_dlsym_raw(NULL, sym)));
 }
 
-/* close a native library handle */
+// close a native library handle
 void factor_vm::primitive_dlclose() {
   dll* d = untag_check<dll>(ctx->pop());
   if (d->handle != NULL)
@@ -157,12 +157,12 @@ void factor_vm::primitive_dll_validp() {
   if (to_boolean(library))
     ctx->replace(tag_boolean(untag_check<dll>(library)->handle != NULL));
   else
-    ctx->replace(true_object);
+    ctx->replace(special_objects[OBJ_CANONICAL_TRUE]);
 }
 
-/* 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) {
-  switch (tagged<object>(obj).type()) {
+  switch (TAG(obj)) {
     case BYTE_ARRAY_TYPE:
       return untag<byte_array>(obj)->data<char>();
     case ALIEN_TYPE:
@@ -171,7 +171,7 @@ char* factor_vm::alien_offset(cell obj) {
       return NULL;
     default:
       type_error(ALIEN_TYPE, obj);
-      return NULL; /* can't happen */
+      return NULL; // can't happen
   }
 }