Re: [Chicken-hackers] incorrect warning during compilation

[Felix Winkelmann]

From: Kristian Lein-Mathisen <address@hidden>
Subject: Re: [Chicken-hackers] incorrect warning during compilation
Date: Fri, 27 Jun 2014 17:13:21 +0200

> Actually, that's really cool! A "string-buffer" type! I wouldn't mind
> seeing this in core. So how does this work, Felix, do we vote and things?

Here is an attempt at Moritzens proposal.


felix

>From f043f6d0811d255483eca03c7eb55583fd852f21 Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Fri, 27 Jun 2014 22:55:12 +0200
Subject: [PATCH] Generalize "scheme-pointer" foreign type to allow giving a
 type for the generated pointer variable holding the
 argument.

---
 c-backend.scm                  |    3 +++
 manual/Foreign type specifiers |    9 ++++++++-
 support.scm                    |   16 +++++++++++++++-
 3 files changed, 26 insertions(+), 2 deletions(-)

diff --git a/c-backend.scm b/c-backend.scm
index 28efda1..dbb2b30 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -1194,6 +1194,7 @@
                (cond 
                 ((and (= 2 len)
                       (memq (car type) '(pointer nonnull-pointer c-pointer 
+                                                 scheme-pointer 
nonnull-scheme-pointer
                                                  nonnull-c-pointer) ) )
                  (foreign-type-declaration (cadr type) (string-append "*" 
target)) )
                 ((and (= 2 len)
@@ -1297,6 +1298,8 @@
               ((nonnull-c-pointer) "C_c_pointer_nn(")
               ((instance) "C_c_pointer_or_null(")
               ((nonnull-instance) "C_c_pointer_nn(")
+              ((scheme-pointer) "C_data_pointer_or_null(")
+              ((nonnull-scheme-pointer) "C_data_pointer(")
               ((function) "C_c_pointer_or_null(")
               ((const) (foreign-argument-conversion (cadr type)))
               ((enum) "C_num_to_int(")
diff --git a/manual/Foreign type specifiers b/manual/Foreign type specifiers
index 19351be..6422e78 100644
--- a/manual/Foreign type specifiers    
+++ b/manual/Foreign type specifiers    
@@ -274,12 +274,18 @@ such objects using the core library routines in 
{{chicken.h}} and
 More information on object structure can be found in [[Data representation]].
 
 <type>scheme-pointer</type><br>
-<type>nonnull-scheme-pointer</type>
+<type>(scheme-pointer TYPE)</type><br>
+<type>nonnull-scheme-pointer</type><br>
+<type>(nonnull-scheme-pointer TYPE)</type>
 
 An untyped pointer to the ''contents'' of a non-immediate Scheme
 object; for example, the raw byte contents of a string. Only allowed
 as an argument type, not a return type.  
 
+The optional element type {{TYPE}} may be used to specify what C
+type should be used in the generated code. This avoids the need
+to cast the argument.
+
 The value {{#f}} is also allowed and is passed as a {{NULL}} pointer.
 For the {{nonnull-}} variant, passing {{#f}} will raise an exception.
 
@@ -382,6 +388,7 @@ The foreign type {{TYPE}} with an additional {{const}} 
qualifier.
 <tr><td>{{symbol}}</td><td>{{char *}}</td></tr>
 <tr><td>{{void}}</td><td>{{void}}</td></tr>
 <tr><td>{{([nonnull-]c-pointer TYPE)}}</td><td>{{TYPE *}}</td></tr>
+<tr><td>{{([nonnull-]scheme-pointer TYPE)}}</td><td>{{TYPE *}}</td></tr>
 <tr><td>{{(enum NAME)}}</td><td>{{enum NAME}}</td></tr>
 <tr><td>{{(struct NAME)}}</td><td>{{struct NAME}}</td></tr>
 <tr><td>{{(ref TYPE)}}</td><td>{{TYPE &}}</td></tr>
diff --git a/support.scm b/support.scm
index d47afb1..dc8a22c 100644
--- a/support.scm
+++ b/support.scm
@@ -1113,6 +1113,18 @@
                             (if ,tmp
                                 (slot-ref ,param 'this)
                                 '#f) ) ) ]
+                      [(scheme-pointer)
+                       (let ([tmp (gensym)])
+                         `(let ([,tmp ,param])
+                            (if ,tmp
+                                ,(if unsafe
+                                     tmp
+                                     `(##sys#foreign-block-argument ,tmp) )
+                                '#f) ) ) ]
+                      [(nonnull-scheme-pointer)
+                       (if unsafe
+                           param
+                           `(##sys#foreign-block-argument ,param) ) ]
                       [(nonnull-instance)
                        `(slot-ref ,param 'this) ]
                       [(const) (repeat (cadr t))]
@@ -1203,7 +1215,9 @@
                    (next (if (vector? t2) (vector-ref t2 0) t2)) ) ]
              [(pair? t)
               (case (car t)
-                [(ref nonnull-pointer pointer c-pointer nonnull-c-pointer 
function) (words->bytes 1)]
+                [(ref nonnull-pointer pointer c-pointer nonnull-c-pointer 
function
+                      scheme-pointer nonnull-scheme-pointer)
+                 (words->bytes 1)]
                 [else (err t)] ) ]
              [else (err t)] ) ) ) )
    (lambda () (quit "foreign type `~S' refers to itself" type)) ) )
-- 
1.7.9.5