> 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 <fe...@call-with-current-continuation.org>
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
_______________________________________________
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers
