From c75baad41d9e6cbe11d83e208ccfe35c18a6b19d Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Wed, 24 May 2017 07:21:30 -0700
Subject: ffi: sanity check on object in ffi_val_get.

* ffi.c (ffi_val_get): Throw an exception if the object
doesn't appear valid.

* gc.c (valid_object_p): New function.  Invalid objects are
those that are pointers, but either not into a heap, or else
to a freed object or to an object that is marked by the
garbage collector (should only be seen while GC is running).
All others are valid.  There can be false positives here: a
value with the LIT tag is in fact a pointer, but we don't
check whether that is valid.

* gc.c (valid_object_p): Declared.

* txr.1: Remarks added to documentation of FFI val type.
---
 ffi.c | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

(limited to 'ffi.c')

diff --git a/ffi.c b/ffi.c
index 84e891e5..d6326d4f 100644
--- a/ffi.c
+++ b/ffi.c
@@ -565,7 +565,11 @@ static void ffi_val_put(struct txr_ffi_type *tft, val v, mem_t *dst, val self)
 
 static val ffi_val_get(struct txr_ffi_type *tft, mem_t *src, val self)
 {
-  return *coerce(val *, src);
+  val v = *coerce(val *, src);
+  if (!valid_object_p(v))
+    uw_throwf(error_s, lit("~a: bit pattern ~0,0*x isn't a valid Lisp object"),
+              self, num_fast(sizeof (v) * 2), bits(v), nao);
+  return v;
 }
 
 #if SIZEOF_WCHAR_T == SIZEOF_SHORT
-- 
cgit v1.2.3