summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ffi.c73
-rw-r--r--ffi.h1
-rw-r--r--txr.153
3 files changed, 117 insertions, 10 deletions
diff --git a/ffi.c b/ffi.c
index 2435bc8b..a383c831 100644
--- a/ffi.c
+++ b/ffi.c
@@ -1891,6 +1891,27 @@ static val ffi_cptr_get(struct txr_ffi_type *tft, mem_t *src, val self)
return cptr_typed(p, tft->tag, 0);
}
+static val ffi_cptr_in(struct txr_ffi_type *tft, int copy, mem_t *src,
+ val ptr, val self)
+{
+ if (ptr) {
+ if (copy) {
+ mem_t *newp = *coerce(mem_t **, src);
+
+ if (type(ptr) == CPTR) {
+ mem_t **addr = cptr_addr_of(ptr, tft->tag, self);
+ *addr = newp;
+ } else {
+ carray_set_ptr(ptr, tft->eltype, newp, self);
+ }
+ }
+ } else {
+ ptr = ffi_cptr_get(tft, src, self);
+ }
+
+ return ptr;
+}
+
static mem_t *ffi_cptr_alloc(struct txr_ffi_type *tft, val ptr, val self)
{
return coerce(mem_t *, cptr_addr_of(ptr, tft->tag, self));
@@ -2946,6 +2967,21 @@ static val ffi_carray_get(struct txr_ffi_type *tft, mem_t *src, val self)
return make_carray(tft->eltype, p, -1, nil, 0);
}
+static val ffi_carray_in(struct txr_ffi_type *tft, int copy, mem_t *src,
+ val carray, val self)
+{
+ if (carray) {
+ if (copy) {
+ mem_t *p = *coerce(mem_t **, src);
+ carray_set_ptr(carray, tft->eltype, p, self);
+ }
+ } else {
+ carray = ffi_carray_get(tft, src, self);
+ }
+
+ return carray;
+}
+
static void ffi_carray_put(struct txr_ffi_type *tft, val carray, mem_t *dst,
val self)
{
@@ -3945,6 +3981,7 @@ val ffi_type_compile(val syntax)
&ffi_type_pointer,
ffi_cptr_put, ffi_cptr_get, 0, 0);
struct txr_ffi_type *tft = ffi_type_struct(type);
+ tft->in = ffi_cptr_in;
tft->alloc = ffi_cptr_alloc;
tft->free = ffi_noop_free;
tft->tag = tag;
@@ -3953,12 +3990,17 @@ val ffi_type_compile(val syntax)
goto excess;
return type;
} else if (sym == carray_s) {
- val eltype = ffi_type_compile(cadr(syntax));
- if (cddr(syntax))
+ if (cddr(syntax)) {
goto excess;
- return make_ffi_type_pointer(syntax, carray_s,
- ffi_carray_put, ffi_carray_get,
- 0, 0, 0, eltype);
+ } else {
+ val eltype = ffi_type_compile(cadr(syntax));
+ val type = make_ffi_type_pointer(syntax, carray_s,
+ ffi_carray_put, ffi_carray_get,
+ 0, 0, 0, eltype);
+ struct txr_ffi_type *tft = ffi_type_struct(type);
+ tft->in = ffi_carray_in;
+ return type;
+ }
} else if (sym == sbit_s || sym == ubit_s) {
val nbits = ffi_eval_expr(cadr(syntax), nil, nil);
cnum nb = c_num(nbits, self);
@@ -4485,6 +4527,7 @@ static void ffi_init_types(void)
&ffi_type_pointer,
ffi_cptr_put, ffi_cptr_get, 0, 0);
struct txr_ffi_type *tft = ffi_type_struct(type);
+ tft->in = ffi_cptr_in;
tft->alloc = ffi_cptr_alloc;
tft->free = ffi_noop_free;
tft->tag = nil;
@@ -5430,6 +5473,26 @@ mem_t *carray_ptr(val carray, val type, val self)
return scry->data;
}
+void carray_set_ptr(val carray, val type, mem_t *ptr, val self)
+{
+ struct carray *scry = carray_struct_checked(self, carray);
+ if (scry->eltype != type)
+ uw_throwf(error_s, lit("~a: ~s is not of element type ~!~s"),
+ self, carray, type, nao);
+ if (carray->co.ops == &carray_borrowed_ops) {
+ /* nothing to do */
+ } else if (carray->co.ops == &carray_owned_ops) {
+ free(scry->data);
+ scry->nelem = 0;
+ carray->co.ops = &carray_borrowed_ops;
+ } else {
+ uw_throwf(error_s, lit("~a: cannot change address of mmapped ~!~s"),
+ self, carray, type, nao);
+ }
+
+ scry->data = ptr;
+}
+
val carray_vec(val vec, val type, val null_term_p)
{
val self = lit("carray-vec");
diff --git a/ffi.h b/ffi.h
index d788d9e8..37a42d65 100644
--- a/ffi.h
+++ b/ffi.h
@@ -104,6 +104,7 @@ val carray_type(val carray);
val length_carray(val carray);
val copy_carray(val carray);
mem_t *carray_ptr(val carray, val type, val self);
+void carray_set_ptr(val carray, val type, mem_t *ptr, val self);
val carray_vec(val vec, val type, val null_term_p);
val carray_list(val list, val type, val null_term_p);
val carray_blank(val nelem, val type);
diff --git a/txr.1 b/txr.1
index ebac5eec..052dc739 100644
--- a/txr.1
+++ b/txr.1
@@ -60548,6 +60548,20 @@ object under control of the FFI
.code cptr
type, the object inherits the type tag from the FFI type.
+Although
+.code cptr
+objects are conceptually non-aggregate values, corresponding to pointers,
+they are
+.I "de facto"
+aggregates due to their implementation as references to heap objects.
+When a
+.code cptr
+object is passed to a foreign function by pointer, for
+instance using a parameter of type
+.codn "(ptr cptr)" ,
+its internal pointer is potentially updated to the new value coming from the
+function.
+
.coNP Function @ cptr-int
.synb
.mets (cptr-int < integer <> [ type-symbol ])
@@ -78383,13 +78397,42 @@ whose element type matches that of the FFI type.
The
.code carray
-type lacks in or out semantics, since FFI doesn't manage any foreign
-memory for the passage of a
+type has in semantics. When a
+.code carray
+is passed to a foreign function as an argument to a
+.code ptr
+or
+.code ptr-out
+parameter to either a
+.code carray
+or
+.code cptr
+type, what is passed to the function is a pointer to the
+.codn carray 's
+pointer. The foreign function may update this pointer to a
+new value, and this value is stored back into the
+.code carray
+object. The array's length is reset to zero.
+If it is an owned
+.codn carray ,
+arranged by
+.codn carray-own ,
+then the current array freed before the new pointer is assigned,
+and the object's type is reset to borrowed array. The
+.code carray
+object must not be memory mapped
+.code carray
+coming from the
+.code mmap
+function.
+
+The
.code carray
-and any bidirectional communication of data through the array
-is handled by performing direct operations on the
+type lacks out semantics, since Lisp code cannot change its address;
+so there is no new pointer to propagate back to a foreign caller
+which passes a
.code carray
-Lisp object in application code.
+to a Lisp callback, and no other memory management tasks to perform.
The
.code carray