From e7b52bf10f64746d3bd1f26d102d91497f29e70d Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 25 Dec 2010 09:31:38 -0600
Subject: [PATCH] fix ffi handling of non-GCable pointers with offsets  Closes
 PR 11567

---
 collects/tests/racket/foreign-test.rktl | 19 +++++++++++++++++++
 src/foreign/foreign.c                   | 14 +++++++++-----
 src/foreign/foreign.rktc                | 17 +++++++++--------
 3 files changed, 37 insertions(+), 13 deletions(-)

diff --git a/collects/tests/racket/foreign-test.rktl b/collects/tests/racket/foreign-test.rktl
index 5618f06138..9c46c516ed 100644
--- a/collects/tests/racket/foreign-test.rktl
+++ b/collects/tests/racket/foreign-test.rktl
@@ -256,6 +256,25 @@
     (test 'hello hash-ref ht seventeen2 #f)
     (test 'hello hash-ref ht seventeen3 #f)))
 
+;; Check proper handling of offsets:
+(let ()
+  (define scheme_make_sized_byte_string 
+    (get-ffi-obj 'scheme_make_sized_byte_string #f (_fun _pointer _long _int -> _scheme)))
+  ;; Non-gcable:
+  (let ()
+    (define p (cast (ptr-add #f 20) _pointer _pointer))
+    (define d (scheme_make_sized_byte_string (ptr-add p 24)
+                                             4
+                                             0))
+    (test 44 values (cast d _pointer _long)))
+  ;; GCable:
+  (let ()
+    (define p (cast (ptr-add #f 20) _pointer _gcpointer))
+    (define d (scheme_make_sized_byte_string (ptr-add p 24)
+                                             4
+                                             0))
+    (test 44 values (cast d _gcpointer _long))))
+
 (delete-test-files)
 
 (report-errs)
diff --git a/src/foreign/foreign.c b/src/foreign/foreign.c
index baa90c0dc3..b200880583 100644
--- a/src/foreign/foreign.c
+++ b/src/foreign/foreign.c
@@ -1676,12 +1676,14 @@ static void* SCHEME2C(Scheme_Object *type, void *dst, intptr_t delta,
         void* tmp; intptr_t toff;
         tmp = (void*)(SCHEME_FFIANYPTR_VAL(val));
         toff = SCHEME_FFIANYPTR_OFFSET(val);
-        if (_offset) *_offset = toff;
         if (basetype_p == NULL || (tmp == NULL && toff == 0) || !is_gcable_pointer(val)) {
-          (((void**)W_OFFSET(dst,delta))[0]) = (_offset ? tmp : (void*)W_OFFSET(tmp, toff));
+          if (_offset) *_offset = 0;
+          (((void**)W_OFFSET(dst,delta))[0]) = (void*)W_OFFSET(tmp, toff);;
           return NULL;
         } else {
           *basetype_p = FOREIGN_pointer;
+          toff = SCHEME_FFIANYPTR_OFFSET(val);
+          if (_offset) *_offset = toff;
           return _offset ? tmp : (void*)W_OFFSET(tmp, toff);
         }
       } else {
@@ -1699,12 +1701,14 @@ static void* SCHEME2C(Scheme_Object *type, void *dst, intptr_t delta,
         void* tmp; intptr_t toff;
         tmp = (void*)(SCHEME_FFIANYPTR_VAL(val));
         toff = SCHEME_FFIANYPTR_OFFSET(val);
-        if (_offset) *_offset = toff;
         if (basetype_p == NULL || (tmp == NULL && toff == 0) || 0) {
-          (((void**)W_OFFSET(dst,delta))[0]) = (_offset ? tmp : (void*)W_OFFSET(tmp, toff));
+          if (_offset) *_offset = 0;
+          (((void**)W_OFFSET(dst,delta))[0]) = (void*)W_OFFSET(tmp, toff);;
           return NULL;
         } else {
           *basetype_p = FOREIGN_gcpointer;
+          toff = SCHEME_FFIANYPTR_OFFSET(val);
+          if (_offset) *_offset = toff;
           return _offset ? tmp : (void*)W_OFFSET(tmp, toff);
         }
       } else {
@@ -1749,7 +1753,7 @@ static void* SCHEME2C(Scheme_Object *type, void *dst, intptr_t delta,
           return NULL;
         } else {
           *basetype_p = FOREIGN_struct;
-          if (_offset) {
+          if (_offset && is_gcable_pointer(val)) {
             *_offset = poff;
             return p;
           } else {
diff --git a/src/foreign/foreign.rktc b/src/foreign/foreign.rktc
index f911a197f1..8c0d31e1b9 100755
--- a/src/foreign/foreign.rktc
+++ b/src/foreign/foreign.rktc
@@ -1156,10 +1156,7 @@ static void* SCHEME2C(Scheme_Object *type, void *dst, intptr_t delta,
                    if (@f[pred]) {
                      @ctype tmp@";"@and[offset]{ intptr_t toff@";"}
                      tmp = (@ctype)(@f[s->c]);
-                     @and[offset @list{
-                       toff = SCHEME_@|offset|_OFFSET(val);
-                       if (_offset) *_offset = toff;@;
-                     @"\n"  }]@;
+                     @and[offset @list{toff = SCHEME_@|offset|_OFFSET(val);@"\n"}]@;
                      @(if ptr?
                           @list{if (basetype_p == NULL || @;
                                     @(if offset
@@ -1168,13 +1165,17 @@ static void* SCHEME2C(Scheme_Object *type, void *dst, intptr_t delta,
                                     @(if (equal? ftype "pointer")
                                          @list{!is_gcable_pointer(val)}
                                          @list{0})) {
+                                  @and[offset @list{if (_offset) *_offset = 0;@"\n"}]@;
                                   @x = @(if offset
-                                          @list{(_offset ? tmp : @;
-                                                   (@ctype)W_OFFSET(tmp, toff))}
-                                          "tmp");
+                                         @list{(@ctype)W_OFFSET(tmp, toff);}
+                                         "tmp");
                                   return NULL;
                                 } else {
                                   *basetype_p = FOREIGN_@cname;
+                                  @and[offset @list{
+                                      toff = SCHEME_@|offset|_OFFSET(val);
+                                      if (_offset) *_offset = toff;@;
+                                      @"\n"  }]@;
                                   return @(if offset
                                             @list{_offset ? tmp : @;
                                                     (@ctype)W_OFFSET(tmp, toff)}
@@ -1199,7 +1200,7 @@ static void* SCHEME2C(Scheme_Object *type, void *dst, intptr_t delta,
           return NULL;
         } else {
           *basetype_p = FOREIGN_struct;
-          if (_offset) {
+          if (_offset && is_gcable_pointer(val)) {
             *_offset = poff;
             return p;
           } else {