From c623658aa2d1d63a0eaad44b5663ac5c0ec75706 Mon Sep 17 00:00:00 2001
From: Phil Dawes <phil@phildawes.net>
Date: Wed, 2 Sep 2009 10:43:21 +0100
Subject: [PATCH] added vm-ptr primitive

---
 core/bootstrap/primitives.factor |  2 ++
 vm/alien.cpp                     | 10 ++++++++++
 vm/alien.hpp                     |  2 ++
 vm/primitives.cpp                |  1 +
 vm/vm.hpp                        |  1 +
 5 files changed, 16 insertions(+)

diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index 355fa8ed58..fc071cc566 100644
--- a/core/bootstrap/primitives.factor
+++ b/core/bootstrap/primitives.factor
@@ -103,6 +103,7 @@ bootstrapping? on
     "words"
     "vectors"
     "vectors.private"
+    "vm"
 } [ create-vocab drop ] each
 
 ! Builtin classes
@@ -518,6 +519,7 @@ tuple
     { "inline-cache-stats" "generic.single" (( -- stats )) }
     { "optimized?" "words" (( word -- ? )) }
     { "quot-compiled?" "quotations" (( quot -- ? )) }
+    { "vm-ptr" "vm" (( -- ptr )) }
 } [ [ first3 ] dip swap make-primitive ] each-index
 
 ! Bump build number
diff --git a/vm/alien.cpp b/vm/alien.cpp
index 829a7efeb6..ea8d0a6026 100755
--- a/vm/alien.cpp
+++ b/vm/alien.cpp
@@ -303,4 +303,14 @@ VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size, f
 	return VM_PTR->box_medium_struct(x1, x2, x3, x4, size);
 }
 
+inline void factorvm::vmprim_vm_ptr()
+{
+	box_alien(this);
+}
+
+PRIMITIVE(vm_ptr)
+{
+	PRIMITIVE_GETVM()->vmprim_vm_ptr();
+}
+
 }
diff --git a/vm/alien.hpp b/vm/alien.hpp
index 7b537146fd..ca3601f51e 100755
--- a/vm/alien.hpp
+++ b/vm/alien.hpp
@@ -36,6 +36,8 @@ PRIMITIVE(dlsym);
 PRIMITIVE(dlclose);
 PRIMITIVE(dll_validp);
 
+PRIMITIVE(vm_ptr);
+
 VM_C_API char *alien_offset(cell object, factorvm *vm);
 VM_C_API char *unbox_alien(factorvm *vm);
 VM_C_API void box_alien(void *ptr, factorvm *vm);
diff --git a/vm/primitives.cpp b/vm/primitives.cpp
index 6dbe281d0c..1cbad03001 100644
--- a/vm/primitives.cpp
+++ b/vm/primitives.cpp
@@ -162,6 +162,7 @@ const primitive_type primitives[] = {
 	primitive_inline_cache_stats,
 	primitive_optimized_p,
 	primitive_quot_compiled_p,
+	primitive_vm_ptr,
 };
 
 }
diff --git a/vm/vm.hpp b/vm/vm.hpp
index c30af505f9..a16ff21121 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -585,6 +585,7 @@ struct factorvm {
 	inline void vmprim_dlsym();
 	inline void vmprim_dlclose();
 	inline void vmprim_dll_validp();
+	inline void vmprim_vm_ptr();
 	char *alien_offset(cell obj);
 	char *unbox_alien();
 	void box_alien(void *ptr);