Re: [Chicken-hackers] incorrect warning during compilation

[Felix Winkelmann]

> I talked to Peter on #chicken and he wasn't happy about another
> foreign-type. I suppose I agree with him, there are quite a few already and
> maybe it'll just be confusing: having a "c-string" and a "string" foreign
> type would probably do more harm than gain.

Well, no problem. Attached a patch for the "string-buffer" type, just
in case someone is interested.


felix

>From 979a967c6e923391dfed5cb225dd20ec4aac6bbb Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Fri, 27 Jun 2014 13:52:50 +0200
Subject: [PATCH] Added foreign types "[nonnull-][unsigned-]string-buffer".

---
 c-backend.scm                  |   19 ++++++++++++-------
 compiler.scm                   |    4 ++++
 manual/Foreign type specifiers |   11 +++++++++++
 support.scm                    |   10 ++++++++++
 4 files changed, 37 insertions(+), 7 deletions(-)

diff --git a/c-backend.scm b/c-backend.scm
index 28efda1..df3df11 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -1092,9 +1092,11 @@
                   nonnull-c-pointer number unsigned-integer64 integer64 
c-string-list
                   c-string-list*)
            (string-append ns "+3") ]
-          [(c-string c-string* unsigned-c-string unsigned-c-string 
unsigned-c-string*)
+          [(c-string c-string* unsigned-c-string unsigned-c-string 
unsigned-c-string*
+                     string-buffer unsigned-string-buffer)
            (string-append ns "+2+(" var "==NULL?1:C_bytestowords(C_strlen(" 
var ")))") ]
-          [(nonnull-c-string nonnull-c-string* nonnull-unsigned-c-string 
nonnull-unsigned-c-string* symbol)
+          [(nonnull-c-string nonnull-c-string* nonnull-unsigned-c-string 
nonnull-unsigned-c-string* symbol
+                             nonnull-string-buffer 
nonnull-unsigned-string-buffer)
            (string-append ns "+2+C_bytestowords(C_strlen(" var "))") ]
           [else
            (cond [(and (symbol? type) (##sys#hash-table-ref foreign-type-table 
type)) 
@@ -1179,9 +1181,10 @@
       [(f32vector nonnull-f32vector) (str "float *")]
       [(f64vector nonnull-f64vector) (str "double *")]
       ((pointer-vector nonnull-pointer-vector) (str "void **"))
-      [(nonnull-c-string c-string nonnull-c-string* c-string* symbol) 
+      [(nonnull-c-string c-string nonnull-c-string* c-string* string-buffer 
nonnull-string-buffer symbol) 
        (str "char *")]
-      [(nonnull-unsigned-c-string nonnull-unsigned-c-string* unsigned-c-string 
unsigned-c-string*)
+      [(nonnull-unsigned-c-string nonnull-unsigned-c-string* unsigned-c-string 
unsigned-c-string*
+                                 unsigned-string-buffer 
nonnull-unsigned-string-buffer)
        (str "unsigned char *")]
       [(void) (str "void")]
       [else
@@ -1283,9 +1286,11 @@
       ((nonnull-f64vector) "C_c_f64vector(")
       ((pointer-vector) "C_c_pointer_vector_or_null(")
       ((nonnull-pointer-vector) "C_c_pointer_vector(")
-      ((c-string c-string* unsigned-c-string unsigned-c-string*) 
"C_string_or_null(")
-      ((nonnull-c-string nonnull-c-string* nonnull-unsigned-c-string 
-                        nonnull-unsigned-c-string* symbol) "C_c_string(")
+      ((c-string c-string* unsigned-c-string unsigned-c-string* string-buffer 
unsigned-string-buffer)
+       "C_string_or_null(")
+      ((nonnull-c-string nonnull-c-string* nonnull-unsigned-c-string 
nonnull-string-buffer
+                        nonnull-unsigned-string-buffer 
nonnull-unsigned-c-string* symbol) 
+       "C_c_string(")
       ((bool) "C_truep(")
       (else
        (cond [(and (symbol? type) (##sys#hash-table-ref foreign-type-table 
type))
diff --git a/compiler.scm b/compiler.scm
index 9fc9f1a..c0fdc9b 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -1215,6 +1215,10 @@
                                                  '((const c-string*)
                                                    (const unsigned-c-string*)
                                                    unsigned-c-string*
+                                                   string-buffer 
+                                                   unsigned-string-buffer
+                                                   nonnull-string-buffer
+                                                   
nonnull-unsigned-string-buffer
                                                    c-string*
                                                    c-string-list
                                                    c-string-list*))
diff --git a/manual/Foreign type specifiers b/manual/Foreign type specifiers
index 19351be..63e9a0f 100644
--- a/manual/Foreign type specifiers    
+++ b/manual/Foreign type specifiers    
@@ -164,6 +164,15 @@ defined with {{define-external}}.
 Same as {{c-string}}, {{nonnull-c-string}}, etc. but mapping to C's
 {{unsigned char *}} type.
 
+<type>string-buffer</type></br>
+<type>nonnull-string-buffer</type></br>
+<type>unsigned-string-buffer</type></br></br>
+<type>nonnull-unsigned-string-buffer</type>
+
+Similar to {{[unsigned-]c-string}}, but doesn't copy the string, nor
+does it append a zero byte. Use this type to pass strings that are
+intended to be modified from foreign code.
+
 <type>c-string-list</type><br>
 <type>c-string-list*</type>
 
@@ -378,6 +387,8 @@ The foreign type {{TYPE}} with an additional {{const}} 
qualifier.
 <tr><td>{{[nonnull-]f64vector}}</td><td>{{double *}}</td></tr>
 <tr><td>{{[nonnull-]c-string}}</td><td>{{char *}}</td></tr>
 <tr><td>{{[nonnull-]unsigned-c-string}}</td><td>{{unsigned char *}}</td></tr>
+<tr><td>{{[nonnull-]string-buffer}}</td><td>{{char *}}</td></tr>
+<tr><td>{{[nonnull-]unsigned-string-buffer}}</td><td>{{unsigned char 
*}}</td></tr>
 <tr><td>{{c-string-list}}</td><td>{{char **}}</td></tr>
 <tr><td>{{symbol}}</td><td>{{char *}}</td></tr>
 <tr><td>{{void}}</td><td>{{void}}</td></tr>
diff --git a/support.scm b/support.scm
index d47afb1..6e9a750 100644
--- a/support.scm
+++ b/support.scm
@@ -1091,6 +1091,16 @@
              (if unsafe 
                  `(##sys#make-c-string ,param)
                  `(##sys#make-c-string (##sys#foreign-string-argument ,param)) 
) ]
+            [(string-buffer unsigned-string-buffer)
+             (let ([tmp (gensym)])
+               `(let ([,tmp ,param])
+                  (if ,tmp
+                      ,(if unsafe 
+                           param
+                           `(##sys#foreign-string-argument ,param))
+                      '#f)))]
+            [(nonnull-string-buffer nonnull-unsigned-string-buffer)
+             `(##sys#foreign-string-argument ,param)]
             [(symbol)
              (if unsafe 
                  `(##sys#make-c-string (##sys#symbol->string ,param))
-- 
1.7.9.5