diff options
-rw-r--r-- | ffi.c | 73 | ||||
-rw-r--r-- | ffi.h | 1 | ||||
-rw-r--r-- | txr.1 | 53 |
3 files changed, 117 insertions, 10 deletions
@@ -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"); @@ -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); @@ -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 |