From 27ba3ad5321efe1393d3736703b7fec2c56e6eb9 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 23 May 2017 21:58:10 -0700
Subject: ffi: val type.

* ffi.c (val_s): New symbol variable.
(ffi_val_put, ffi_val_get): New functions.
(ffi_init_types): Register val type.
(ffi_init): Initialize val_s.

* ffi.h (val_s): Declared.

* txr.1: Documented.
---
 ffi.c | 20 +++++++++++++++++++-
 ffi.h |  2 ++
 txr.1 | 18 ++++++++++++++++++
 3 files changed, 39 insertions(+), 1 deletion(-)

diff --git a/ffi.c b/ffi.c
index bf4c401b..84e891e5 100644
--- a/ffi.c
+++ b/ffi.c
@@ -74,6 +74,8 @@ val long_s, ulong_s;
 val double_s;
 val void_s;
 
+val val_s;
+
 val array_s, zarray_s, carray_s;
 
 val struct_s;
@@ -82,6 +84,7 @@ val str_d_s, wstr_s, wstr_d_s, bstr_s, bstr_d_s;
 
 val buf_d_s;
 
+
 val ptr_in_s, ptr_out_s, ptr_in_d_s, ptr_out_d_s, ptr_out_s_s, ptr_s;
 
 val closure_s;
@@ -555,6 +558,16 @@ static val ffi_double_get(struct txr_ffi_type *tft, mem_t *src, val self)
   return flo(n);
 }
 
+static void ffi_val_put(struct txr_ffi_type *tft, val v, mem_t *dst, val self)
+{
+  *coerce(val *, dst) = v;
+}
+
+static val ffi_val_get(struct txr_ffi_type *tft, mem_t *src, val self)
+{
+  return *coerce(val *, src);
+}
+
 #if SIZEOF_WCHAR_T == SIZEOF_SHORT
 #define ffi_type_wchar ffi_type_ushort
 #elif SIZEOF_WCHAR_T == SIZEOF_INT
@@ -1894,7 +1907,11 @@ static void ffi_init_types(void)
                                               alignof (double),
                                               &ffi_type_double,
                                               ffi_double_put, ffi_double_get));
-
+  ffi_typedef(val_s, make_ffi_type_builtin(val_s, t,
+                                           sizeof (val),
+                                           alignof (val),
+                                           &ffi_type_pointer,
+                                           ffi_val_put, ffi_val_get));
   {
     val type = make_ffi_type_builtin(cptr_s, cptr_s, sizeof (mem_t *),
                                      alignof (mem_t *),
@@ -2804,6 +2821,7 @@ void ffi_init(void)
   long_s = intern(lit("long"), user_package);
   ulong_s = intern(lit("ulong"), user_package);
   double_s = intern(lit("double"), user_package);
+  val_s = intern(lit("val"), user_package);
   void_s = intern(lit("void"), user_package);
   array_s = intern(lit("array"), user_package);
   zarray_s = intern(lit("zarray"), user_package);
diff --git a/ffi.h b/ffi.h
index 3f415082..c6a7102a 100644
--- a/ffi.h
+++ b/ffi.h
@@ -37,6 +37,8 @@ extern val long_s, ulong_s;
 extern val void_s;
 extern val double_s;
 
+extern val val_s;
+
 extern val array_s, zarray_s, carray_s;
 
 extern val struct_s;
diff --git a/txr.1 b/txr.1
index 81124def..9ba9d20d 100644
--- a/txr.1
+++ b/txr.1
@@ -53374,6 +53374,24 @@ only \*(TL
 .code float
 type.
 
+.ccIP @ val
+The FFI
+.code val
+type denotes the machine representation of a Lisp value cell, which is
+corresponds to a C pointer. Not all cell values are actually pointers, but
+values that are heap objects, such as vectors and conses, are.
+The
+.code val
+type transparently converts any Lisp object to a foreign pointer value
+with no representation change at all; and performs the reverse conversion
+from pointer to Lisp value.
+
+Note: this is utterly dangerous. Lisp values that aren't pointers must not
+be dereferenced by foreign code. Foreign code must not generate Lisp pointer
+values that aren't objects which came from a Lisp heap.
+Interpreting a Lisp value in foreign code requires a correct decoding of
+its type tag, and, if necessary, stripping the tag bits to recover a heap
+pointer and interpreting the type code stored in the heap object.
 .ccIP @ cptr
 This type corresponds to a C pointer of any type, including a function pointer;
 \*(TX doesn't run on any exotic platforms in which there is a representational
-- 
cgit v1.2.3