summaryrefslogtreecommitdiffstats
path: root/ffi.c
diff options
context:
space:
mode:
Diffstat (limited to 'ffi.c')
-rw-r--r--ffi.c312
1 files changed, 200 insertions, 112 deletions
diff --git a/ffi.c b/ffi.c
index b760bfb2..2d2aa476 100644
--- a/ffi.c
+++ b/ffi.c
@@ -84,13 +84,17 @@ struct txr_ffi_type {
val mtypes;
cnum size, align;
cnum nelem;
- void (*put)(struct txr_ffi_type *, val obj, mem_t *dst, val self);
+ int rtidx, rtsize;
+ void (*walk)(struct txr_ffi_type *, mem_t *ctx,
+ void (*visit)(struct txr_ffi_type *, mem_t *ctx));
+ void (*put)(struct txr_ffi_type *, val obj, mem_t *dst,
+ mem_t *rtvec[], val self);
val (*get)(struct txr_ffi_type *, mem_t *src, val self);
- void (*in)(struct txr_ffi_type *, val obj, val self);
+ void (*in)(struct txr_ffi_type *, val obj,
+ mem_t *rtvec[], val self);
mem_t *(*alloc)(struct txr_ffi_type *, val obj, val self);
void (*free)(void *);
void (*fill)(struct txr_ffi_type *, mem_t *src, val obj, val self);
- mem_t *buf;
};
static struct txr_ffi_type *ffi_type_struct(val obj)
@@ -117,16 +121,6 @@ static void ffi_type_print_op(val obj, val out, val pretty, struct strm_ctx *ctx
format(out, lit(" ~!~s>"), tft->syntax, nao);
}
-static void ffi_builtin_type_struct_destroy_op(val obj)
-{
- struct txr_ffi_type *tft = ffi_type_struct(obj);
-
- if (tft->in)
- (void) tft->in(tft, nil, nil);
-
- free(obj->co.handle);
-}
-
static void ffi_type_struct_destroy_op(val obj)
{
struct txr_ffi_type *tft = ffi_type_struct(obj);
@@ -145,10 +139,6 @@ static void ffi_type_struct_destroy_op(val obj)
free(ft);
tft->ft = 0;
-
- if (tft->in)
- (void) tft->in(tft, nil, nil);
-
free(tft);
}
@@ -172,7 +162,7 @@ static void ffi_ptr_type_mark(val obj)
static struct cobj_ops ffi_type_builtin_ops =
cobj_ops_init(eq,
ffi_type_print_op,
- ffi_builtin_type_struct_destroy_op,
+ cobj_destroy_free_op,
cobj_mark_op,
cobj_hash_op);
@@ -186,17 +176,18 @@ static struct cobj_ops ffi_type_struct_ops =
static struct cobj_ops ffi_type_ptr_ops =
cobj_ops_init(eq,
ffi_type_print_op,
- ffi_builtin_type_struct_destroy_op,
+ cobj_destroy_free_op,
ffi_ptr_type_mark,
cobj_hash_op);
-static void ffi_void_put(struct txr_ffi_type *tft,
- val n, mem_t *dst, val self)
+static void ffi_void_put(struct txr_ffi_type *tft, val n, mem_t *dst,
+ mem_t *rtvec[], val self)
{
(void) tft;
(void) n;
(void) dst;
(void) self;
+ (void) rtvec;
}
static mem_t *ffi_fixed_alloc(struct txr_ffi_type *tft, val obj, val self)
@@ -220,10 +211,11 @@ static val ffi_void_get(struct txr_ffi_type *tft, mem_t *src, val self)
}
#if HAVE_I8
-static void ffi_i8_put(struct txr_ffi_type *tft,
- val n, mem_t *dst, val self)
+static void ffi_i8_put(struct txr_ffi_type *tft, val n, mem_t *dst,
+ mem_t *rtvec[], val self)
{
(void) tft;
+ (void) rtvec;
i8_t v = c_i8(n, self);
memcpy(dst, &v, sizeof v);
}
@@ -235,10 +227,11 @@ static val ffi_i8_get(struct txr_ffi_type *tft, mem_t *src, val self)
return num_fast(*src);
}
-static void ffi_u8_put(struct txr_ffi_type *tft,
- val n, mem_t *dst, val self)
+static void ffi_u8_put(struct txr_ffi_type *tft, val n, mem_t *dst,
+ mem_t *rtvec[], val self)
{
(void) tft;
+ (void) rtvec;
u8_t v = c_u8(n, self);
memcpy(dst, &v, sizeof v);
}
@@ -253,10 +246,11 @@ static val ffi_u8_get(struct txr_ffi_type *tft, mem_t *src, val self)
#endif
#if HAVE_I16
-static void ffi_i16_put(struct txr_ffi_type *tft,
- val n, mem_t *dst, val self)
+static void ffi_i16_put(struct txr_ffi_type *tft, val n, mem_t *dst,
+ mem_t *rtvec[], val self)
{
(void) tft;
+ (void) rtvec;
i16_t v = c_i16(n, self);
memcpy(dst, &v, sizeof v);
}
@@ -270,10 +264,11 @@ static val ffi_i16_get(struct txr_ffi_type *tft, mem_t *src, val self)
return num_fast(n);
}
-static void ffi_u16_put(struct txr_ffi_type *tft,
- val n, mem_t *dst, val self)
+static void ffi_u16_put(struct txr_ffi_type *tft, val n, mem_t *dst,
+ mem_t *rtvec[], val self)
{
(void) tft;
+ (void) rtvec;
u16_t v = c_u16(n, self);
memcpy(dst, &v, sizeof v);
}
@@ -289,10 +284,11 @@ static val ffi_u16_get(struct txr_ffi_type *tft, mem_t *src, val self)
#endif
#if HAVE_I32
-static void ffi_i32_put(struct txr_ffi_type *tft,
- val n, mem_t *dst, val self)
+static void ffi_i32_put(struct txr_ffi_type *tft, val n, mem_t *dst,
+ mem_t *rtvec[], val self)
{
(void) tft;
+ (void) rtvec;
i32_t v = c_i32(n, self);
memcpy(dst, &v, sizeof v);
}
@@ -306,10 +302,11 @@ static val ffi_i32_get(struct txr_ffi_type *tft, mem_t *src, val self)
return num(n);
}
-static void ffi_u32_put(struct txr_ffi_type *tft,
- val n, mem_t *dst, val self)
+static void ffi_u32_put(struct txr_ffi_type *tft, val n, mem_t *dst,
+ mem_t *rtvec[], val self)
{
(void) tft;
+ (void) rtvec;
u32_t v = c_u32(n, self);
memcpy(dst, &v, sizeof v);
}
@@ -325,11 +322,12 @@ static val ffi_u32_get(struct txr_ffi_type *tft, mem_t *src, val self)
#endif
#if HAVE_I64
-static void ffi_i64_put(struct txr_ffi_type *tft,
- val n, mem_t *dst, val self)
+static void ffi_i64_put(struct txr_ffi_type *tft, val n, mem_t *dst,
+ mem_t *rtvec[], val self)
{
i64_t v = c_i64(n, self);
(void) tft;
+ (void) rtvec;
memcpy(dst, &v, sizeof v);
}
@@ -349,9 +347,11 @@ static val ffi_i64_get(struct txr_ffi_type *tft, mem_t *src, val self)
}
}
-static void ffi_u64_put(struct txr_ffi_type *tft,
- val n, mem_t *dst, val self)
+static void ffi_u64_put(struct txr_ffi_type *tft, val n, mem_t *dst,
+ mem_t *rtvec[], val self)
{
+ (void) tft;
+ (void) rtvec;
u64_t v = c_u64(n, self);
memcpy(dst, &v, sizeof v);
}
@@ -374,11 +374,12 @@ static val ffi_u64_get(struct txr_ffi_type *tft, mem_t *src, val self)
#endif
-static void ffi_char_put(struct txr_ffi_type *tft,
- val n, mem_t *dst, val self)
+static void ffi_char_put(struct txr_ffi_type *tft, val n, mem_t *dst,
+ mem_t *rtvec[], val self)
{
char v = c_char(n, self);
(void) tft;
+ (void) rtvec;
memcpy(dst, &v, sizeof v);
}
@@ -389,11 +390,12 @@ static val ffi_char_get(struct txr_ffi_type *tft, mem_t *src, val self)
return num_fast(*coerce(char *, src));
}
-static void ffi_uchar_put(struct txr_ffi_type *tft,
- val n, mem_t *dst, val self)
+static void ffi_uchar_put(struct txr_ffi_type *tft, val n, mem_t *dst,
+ mem_t *rtvec[], val self)
{
unsigned char v = c_uchar(n, self);
(void) tft;
+ (void) rtvec;
memcpy(dst, &v, sizeof v);
}
@@ -404,11 +406,12 @@ static val ffi_uchar_get(struct txr_ffi_type *tft, mem_t *src, val self)
return num_fast(*src);
}
-static void ffi_short_put(struct txr_ffi_type *tft,
- val n, mem_t *dst, val self)
+static void ffi_short_put(struct txr_ffi_type *tft, val n, mem_t *dst,
+ mem_t *rtvec[], val self)
{
short v = c_short(n, self);
(void) tft;
+ (void) rtvec;
memcpy(dst, &v, sizeof v);
}
@@ -421,11 +424,12 @@ static val ffi_short_get(struct txr_ffi_type *tft, mem_t *src, val self)
return num_fast(n);
}
-static void ffi_ushort_put(struct txr_ffi_type *tft,
- val n, mem_t *dst, val self)
+static void ffi_ushort_put(struct txr_ffi_type *tft, val n, mem_t *dst,
+ mem_t *rtvec[], val self)
{
unsigned short v = c_ushort(n, self);
(void) tft;
+ (void) rtvec;
memcpy(dst, &v, sizeof v);
}
@@ -438,11 +442,12 @@ static val ffi_ushort_get(struct txr_ffi_type *tft, mem_t *src, val self)
return num_fast(n);
}
-static void ffi_int_put(struct txr_ffi_type *tft,
- val n, mem_t *dst, val self)
+static void ffi_int_put(struct txr_ffi_type *tft, val n, mem_t *dst,
+ mem_t *rtvec[], val self)
{
int v = c_int(n, self);
(void) tft;
+ (void) rtvec;
memcpy(dst, &v, sizeof v);
}
@@ -455,11 +460,12 @@ static val ffi_int_get(struct txr_ffi_type *tft, mem_t *src, val self)
return num(n);
}
-static void ffi_uint_put(struct txr_ffi_type *tft,
- val n, mem_t *dst, val self)
+static void ffi_uint_put(struct txr_ffi_type *tft, val n, mem_t *dst,
+ mem_t *rtvec[], val self)
{
unsigned v = c_uint(n, self);
(void) tft;
+ (void) rtvec;
memcpy(dst, &v, sizeof v);
}
@@ -472,11 +478,12 @@ static val ffi_uint_get(struct txr_ffi_type *tft, mem_t *src, val self)
return unum(n);
}
-static void ffi_long_put(struct txr_ffi_type *tft,
- val n, mem_t *dst, val self)
+static void ffi_long_put(struct txr_ffi_type *tft, val n, mem_t *dst,
+ mem_t *rtvec[], val self)
{
long v = c_long(n, self);
(void) tft;
+ (void) rtvec;
memcpy(dst, &v, sizeof v);
}
@@ -489,11 +496,12 @@ static val ffi_long_get(struct txr_ffi_type *tft, mem_t *src, val self)
return num(n);
}
-static void ffi_ulong_put(struct txr_ffi_type *tft,
- val n, mem_t *dst, val self)
+static void ffi_ulong_put(struct txr_ffi_type *tft, val n, mem_t *dst,
+ mem_t *rtvec[], val self)
{
unsigned long v = c_ulong(n, self);
(void) tft;
+ (void) rtvec;
memcpy(dst, &v, sizeof v);
}
@@ -506,12 +514,13 @@ static val ffi_ulong_get(struct txr_ffi_type *tft, mem_t *src, val self)
return unum(n);
}
-static void ffi_float_put(struct txr_ffi_type *tft,
- val n, mem_t *dst, val self)
+static void ffi_float_put(struct txr_ffi_type *tft, val n, mem_t *dst,
+ mem_t *rtvec[], val self)
{
double f = c_flo(n);
double v;
(void) tft;
+ (void) rtvec;
if (f > FLT_MAX || f < FLT_MIN)
uw_throwf(error_s, lit("~a: ~s is out of float range"), self, num, nao);
v = f;
@@ -527,11 +536,12 @@ static val ffi_float_get(struct txr_ffi_type *tft, mem_t *src, val self)
return flo(n);
}
-static void ffi_double_put(struct txr_ffi_type *tft,
- val n, mem_t *dst, val self)
+static void ffi_double_put(struct txr_ffi_type *tft, val n, mem_t *dst,
+ mem_t *rtvec[], val self)
{
double v = c_flo(n);
(void) tft;
+ (void) rtvec;
memcpy(dst, &v, sizeof v);
}
@@ -544,11 +554,12 @@ static val ffi_double_get(struct txr_ffi_type *tft, mem_t *src, val self)
return flo(n);
}
-static void ffi_cptr_put(struct txr_ffi_type *tft,
- val n, mem_t *dst, val self)
+static void ffi_cptr_put(struct txr_ffi_type *tft, val n, mem_t *dst,
+ mem_t *rtvec[], val self)
{
mem_t *p = cptr_get(n);
(void) tft;
+ (void) rtvec;
memcpy(dst, &p, sizeof p);
}
@@ -567,21 +578,22 @@ static mem_t *ffi_cptr_alloc(struct txr_ffi_type *tft, val ptr, val self)
return coerce(mem_t *, cptr_addr_of(ptr));
}
-static void ffi_freeing_in(struct txr_ffi_type *tft, val obj, val self)
+static void ffi_freeing_in(struct txr_ffi_type *tft, val obj,
+ mem_t *rtvec[], val self)
{
+ mem_t **loc = &rtvec[tft->rtidx];
(void) obj;
(void) self;
- free(tft->buf);
- tft->buf = 0;
+ free(*loc);
+ *loc = 0;
}
-static void ffi_str_put(struct txr_ffi_type *tft,
- val s, mem_t *dst, val self)
+static void ffi_str_put(struct txr_ffi_type *tft, val s, mem_t *dst,
+ mem_t *rtvec[], val self)
{
const wchar_t *ws = c_str(s);
char *u8s = utf8_dup_to(ws);
- free(tft->buf);
- tft->buf = coerce(mem_t *, u8s);
+ rtvec[tft->rtidx] = coerce(mem_t *, u8s);
*coerce(const char **, dst) = u8s;
}
@@ -594,9 +606,11 @@ static val ffi_str_get(struct txr_ffi_type *tft, mem_t *src, val self)
return string_utf8(p);
}
-static void ffi_wstr_put(struct txr_ffi_type *tft,
- val s, mem_t *dst, val self)
+static void ffi_wstr_put(struct txr_ffi_type *tft, val s, mem_t *dst,
+ mem_t *rtvec[], val self)
{
+ (void) tft;
+ (void) rtvec;
const wchar_t *ws = c_str(s);
*coerce(const wchar_t **, dst) = ws;
}
@@ -609,9 +623,10 @@ static val ffi_wstr_get(struct txr_ffi_type *tft, mem_t *src, val self)
return string(p);
}
-static void ffi_buf_put(struct txr_ffi_type *tft,
- val buf, mem_t *dst, val self)
+static void ffi_buf_put(struct txr_ffi_type *tft, val buf, mem_t *dst,
+ mem_t *rtvec[], val self)
{
+ (void) rtvec;
mem_t *b = buf_get(buf, self);
*coerce(const mem_t **, dst) = b;
}
@@ -630,41 +645,55 @@ static mem_t *ffi_buf_alloc(struct txr_ffi_type *tft, val buf, val self)
return buf_get(buf, self);
}
-static void ffi_ptr_in_in(struct txr_ffi_type *tft, val obj, val self)
+static void ffi_ptr_walk(struct txr_ffi_type *tft, mem_t *ctx,
+ void (*visit)(struct txr_ffi_type *, mem_t *ctx))
{
val tgttype = tft->mtypes;
struct txr_ffi_type *tgtft = ffi_type_struct(tgttype);
- tgtft->free(tft->buf);
- tft->buf = 0;
+ if (tgtft->walk)
+ tgtft->walk(tgtft, ctx, visit);
+ visit(tgtft, ctx);
}
-static void ffi_ptr_in_put(struct txr_ffi_type *tft,
- val s, mem_t *dst, val self)
+static void ffi_ptr_in_in(struct txr_ffi_type *tft, val obj,
+ mem_t *rtvec[], val self)
+{
+ val tgttype = tft->mtypes;
+ struct txr_ffi_type *tgtft = ffi_type_struct(tgttype);
+ mem_t **loc = &rtvec[tft->rtidx];
+ tgtft->free(*loc);
+ *loc = 0;
+}
+
+static void ffi_ptr_in_put(struct txr_ffi_type *tft, val s, mem_t *dst,
+ mem_t *rtvec[], val self)
{
val tgttype = tft->mtypes;
struct txr_ffi_type *tgtft = ffi_type_struct(tgttype);
mem_t *buf = tgtft->alloc(tgtft, s, self);
- tgtft->put(tgtft, s, buf, self);
- tft->buf = buf;
+ tgtft->put(tgtft, s, buf, rtvec, self);
+ rtvec[tft->rtidx] = buf;
}
-static void ffi_ptr_out_in(struct txr_ffi_type *tft, val obj, val self)
+static void ffi_ptr_out_in(struct txr_ffi_type *tft, val obj,
+ mem_t *rtvec[], val self)
{
val tgttype = tft->mtypes;
struct txr_ffi_type *tgtft = ffi_type_struct(tgttype);
+ mem_t **loc = &rtvec[tft->rtidx];
if (tgtft->fill != 0)
- tgtft->fill(tgtft, tft->buf, obj, self);
- tgtft->free(tft->buf);
- tft->buf = 0;
+ tgtft->fill(tgtft, *loc, obj, self);
+ tgtft->free(*loc);
+ *loc = 0;
}
-static void ffi_ptr_out_put(struct txr_ffi_type *tft,
- val s, mem_t *dst, val self)
+static void ffi_ptr_out_put(struct txr_ffi_type *tft, val s, mem_t *dst,
+ mem_t *rtvec[], val self)
{
val tgttype = tft->mtypes;
struct txr_ffi_type *tgtft = ffi_type_struct(tgttype);
mem_t *buf = tgtft->alloc(tgtft, s, self);
- tft->buf = buf;
+ rtvec[tft->rtidx] = buf;
*coerce(mem_t **, dst) = buf;
}
@@ -676,18 +705,33 @@ static val ffi_ptr_out_get(struct txr_ffi_type *tft, mem_t *src, val self)
return tgtft->get(tgtft, ptr, self);
}
-static void ffi_ptr_in_out_put(struct txr_ffi_type *tft,
- val s, mem_t *dst, val self)
+static void ffi_ptr_in_out_put(struct txr_ffi_type *tft, val s, mem_t *dst,
+ mem_t *rtvec[], val self)
{
val tgttype = tft->mtypes;
struct txr_ffi_type *tgtft = ffi_type_struct(tgttype);
mem_t *buf = tgtft->alloc(tgtft, s, self);
- tgtft->put(tgtft, s, buf, self);
- tft->buf = buf;
+ tgtft->put(tgtft, s, buf, rtvec, self);
+ rtvec[tft->rtidx] = buf;
*coerce(mem_t **, dst) = buf;
}
-static void ffi_struct_in(struct txr_ffi_type *tft, val obj, val self)
+static void ffi_struct_walk(struct txr_ffi_type *tft, mem_t *ctx,
+ void (*visit)(struct txr_ffi_type *, mem_t *ctx))
+{
+ val types = tft->mtypes;
+
+ while (types) {
+ val type = pop(&types);
+ struct txr_ffi_type *mtft = ffi_type_struct(type);
+ if (mtft->walk != 0)
+ mtft->walk(mtft, ctx, visit);
+ visit(mtft, ctx);
+ }
+}
+
+static void ffi_struct_in(struct txr_ffi_type *tft, val obj,
+ mem_t *rtvec[], val self)
{
val types = tft->mtypes;
@@ -695,12 +739,12 @@ static void ffi_struct_in(struct txr_ffi_type *tft, val obj, val self)
val type = pop(&types);
struct txr_ffi_type *mtft = ffi_type_struct(type);
if (mtft->in != 0)
- mtft->in(mtft, obj, self);
+ mtft->in(mtft, obj, rtvec, self);
}
}
-static void ffi_struct_put(struct txr_ffi_type *tft,
- val strct, mem_t *dst, val self)
+static void ffi_struct_put(struct txr_ffi_type *tft, val strct, mem_t *dst,
+ mem_t *rtvec[], val self)
{
val slots = tft->mnames;
val types = tft->mtypes;
@@ -713,7 +757,7 @@ static void ffi_struct_put(struct txr_ffi_type *tft,
struct txr_ffi_type *mtft = ffi_type_struct(type);
ucnum almask = mtft->align - 1;
offs = (offs + almask) & ~almask;
- mtft->put(mtft, slval, dst + offs, self);
+ mtft->put(mtft, slval, dst + offs, rtvec, self);
offs += mtft->size;
}
}
@@ -761,7 +805,8 @@ static void ffi_struct_fill(struct txr_ffi_type *tft, mem_t *src,
}
}
-static void ffi_array_in(struct txr_ffi_type *tft, val obj, val self)
+static void ffi_array_in(struct txr_ffi_type *tft, val obj,
+ mem_t *rtvec[], val self)
{
val eltypes = tft->mtypes;
cnum nelem = tft->nelem, i;
@@ -770,12 +815,12 @@ static void ffi_array_in(struct txr_ffi_type *tft, val obj, val self)
val eltype = pop(&eltypes);
struct txr_ffi_type *etft = ffi_type_struct(eltype);
if (etft->in != 0)
- etft->in(etft, obj, self);
+ etft->in(etft, obj, rtvec, self);
}
}
-static void ffi_array_put(struct txr_ffi_type *tft,
- val vec, mem_t *dst, val self)
+static void ffi_array_put(struct txr_ffi_type *tft, val vec, mem_t *dst,
+ mem_t *rtvec[], val self)
{
val eltypes = tft->mtypes;
cnum nelem = tft->nelem, i;
@@ -786,7 +831,7 @@ static void ffi_array_put(struct txr_ffi_type *tft,
struct txr_ffi_type *etft = ffi_type_struct(eltype);
cnum elsize = etft->size;
val elval = ref(vec, num_fast(i));
- etft->put(etft, elval, dst + offs, self);
+ etft->put(etft, elval, dst + offs, rtvec, self);
offs += elsize;
}
}
@@ -830,7 +875,8 @@ static void ffi_array_fill(struct txr_ffi_type *tft, mem_t *src,
static val make_ffi_type_builtin(val syntax, val lisp_type,
cnum size, ffi_type *ft,
void (*put)(struct txr_ffi_type *,
- val obj, mem_t *dst, val self),
+ val obj, mem_t *dst,
+ mem_t *rtvec[], val self),
val (*get)(struct txr_ffi_type *,
mem_t *src, val self))
{
@@ -854,12 +900,13 @@ static val make_ffi_type_builtin(val syntax, val lisp_type,
static val make_ffi_type_pointer(val syntax, val lisp_type,
cnum size, ffi_type *ft,
- void (*put)(struct txr_ffi_type *,
- val obj, mem_t *dst, val self),
+ void (*put)(struct txr_ffi_type *, val obj,
+ mem_t *dst, mem_t *rtvec[],
+ val self),
val (*get)(struct txr_ffi_type *,
mem_t *src, val self),
- void (*in)(struct txr_ffi_type *,
- val obj, val self),
+ void (*in)(struct txr_ffi_type *, val obj,
+ mem_t *rtvec[], val self),
val tgtype)
{
struct txr_ffi_type *tft = coerce(struct txr_ffi_type *,
@@ -872,6 +919,8 @@ static val make_ffi_type_pointer(val syntax, val lisp_type,
tft->lt = lisp_type;
tft->mnames = tft->mtypes = nil;
tft->size = tft->align = size;
+ tft->rtsize = 1;
+ tft->walk = ffi_ptr_walk;
tft->put = put;
tft->get = get;
tft->mtypes = tgtype;
@@ -882,7 +931,6 @@ static val make_ffi_type_pointer(val syntax, val lisp_type,
return obj;
}
-
static val make_ffi_type_struct(val syntax, val lisp_type,
val slots, val types)
{
@@ -896,7 +944,7 @@ static val make_ffi_type_struct(val syntax, val lisp_type,
val obj = cobj(coerce(mem_t *, tft), ffi_type_s, &ffi_type_struct_ops);
cnum total_size = 0;
cnum most_align = 0;
- int in_handler_needed = 0;
+ int rtsize = 0;
ft->type = FFI_TYPE_STRUCT;
ft->size = 0;
@@ -906,6 +954,7 @@ static val make_ffi_type_struct(val syntax, val lisp_type,
tft->lt = lisp_type;
tft->mnames = slots;
tft->mtypes = types;
+ tft->walk = ffi_struct_walk;
tft->put = ffi_struct_put;
tft->get = ffi_struct_get;
tft->alloc = ffi_fixed_alloc;
@@ -924,13 +973,15 @@ static val make_ffi_type_struct(val syntax, val lisp_type,
most_align = align;
total_size = (total_size + align - 1) / align * align + size;
- in_handler_needed = in_handler_needed || mtft->in != 0;
+ rtsize += mtft->rtsize;
}
elements[i] = 0;
- if (in_handler_needed)
+ if (rtsize != 0) {
+ tft->rtsize = rtsize;
tft->in = ffi_struct_in;
+ }
ft->elements = elements;
@@ -962,6 +1013,7 @@ static val make_ffi_type_array(val syntax, val lisp_type,
tft->lt = lisp_type;
tft->mnames = nil;
tft->mtypes = eltypes;
+ tft->walk = ffi_struct_walk;
tft->put = ffi_array_put;
tft->get = ffi_array_get;
tft->alloc = ffi_fixed_alloc;
@@ -975,9 +1027,11 @@ static val make_ffi_type_array(val syntax, val lisp_type,
if (i == 0) {
tft->size = etft->size * nelem;
tft->align = etft->align;
+ if (etft->rtsize != 0) {
+ tft->rtsize = etft->rtsize * nelem;
+ tft->in = ffi_array_in;
+ }
}
- if (i == 0 && etft->in != 0)
- tft->in = ffi_array_in;
}
elements[i] = 0;
@@ -989,6 +1043,15 @@ static val make_ffi_type_array(val syntax, val lisp_type,
return obj;
}
+static void ffi_type_walk(val type, mem_t *ctx,
+ void (*visit)(struct txr_ffi_type *, mem_t *ctx))
+{
+ struct txr_ffi_type *tft = ffi_type_struct(type);
+ if (tft->walk != 0)
+ tft->walk(tft, ctx, visit);
+ visit(tft, ctx);
+}
+
static val ffi_struct_compile(val membs, val *ptypes, val self)
{
list_collect_decl (slots, pstail);
@@ -1174,6 +1237,7 @@ val ffi_type_compile(val syntax)
ffi_str_put, ffi_str_get);
struct txr_ffi_type *tft = ffi_type_struct(type);
tft->in = ffi_freeing_in;
+ tft->rtsize = 1;
return type;
} else if (syntax == wstr_s) {
return make_ffi_type_builtin(syntax, cptr_s, sizeof (mem_t *),
@@ -1196,6 +1260,26 @@ val ffi_type_compile(val syntax)
}
}
+static void assign_rtindices_visit(struct txr_ffi_type *tft, mem_t *ctx)
+{
+ int *counter = coerce(int *, ctx);
+ if (tft->in != 0)
+ tft->rtidx = (*counter)++;
+}
+
+static void ffi_type_assign_rtindices(val type)
+{
+ int counter = 0;
+ ffi_type_walk(type, coerce(mem_t *, &counter), assign_rtindices_visit);
+}
+
+val ffi_type_compile_toplevel(val syntax)
+{
+ val type = ffi_type_compile(syntax);
+ ffi_type_assign_rtindices(type);
+ return type;
+}
+
struct txr_ffi_call_desc {
ffi_cif cif;
ffi_type **args;
@@ -1291,6 +1375,7 @@ val ffi_call_wrap(val ffi_call_desc, val fptr, val args_in)
val types = tfcd->argtypes;
val rtype = tfcd->rettype;
struct txr_ffi_type *rtft = ffi_type_struct(rtype);
+ mem_t ***rtvec = coerce(mem_t ***, alloca(sizeof *rtvec * tfcd->ntotal));
void *rc = alloca(rtft->size);
int in_pass_needed = 0;
@@ -1298,8 +1383,11 @@ val ffi_call_wrap(val ffi_call_desc, val fptr, val args_in)
val type = pop(&types);
val arg = pop(&args);
struct txr_ffi_type *mtft = ffi_type_struct(type);
+ rtvec[i] = mtft->rtsize
+ ? coerce(mem_t **, alloca(mtft->rtsize * sizeof *rtvec[0]))
+ : 0;
values[i] = alloca(mtft->size);
- mtft->put(mtft, arg, convert(mem_t *, values[i]), self);
+ mtft->put(mtft, arg, convert(mem_t *, values[i]), rtvec[i], self);
in_pass_needed = in_pass_needed || mtft->in != 0;
}
@@ -1313,7 +1401,7 @@ val ffi_call_wrap(val ffi_call_desc, val fptr, val args_in)
val arg = pop(&args);
struct txr_ffi_type *mtft = ffi_type_struct(type);
if (mtft->in != 0)
- mtft->in(mtft, arg, self);
+ mtft->in(mtft, arg, rtvec[i], self);
}
}
@@ -1354,7 +1442,7 @@ void ffi_init(void)
ptr_in_out_s = intern(lit("ptr-in-out"), user_package);
ffi_type_s = intern(lit("ffi-type"), user_package);
ffi_call_desc_s = intern(lit("ffi-call-desc"), user_package);
- reg_fun(intern(lit("ffi-type-compile"), user_package), func_n1(ffi_type_compile));
+ reg_fun(intern(lit("ffi-type-compile"), user_package), func_n1(ffi_type_compile_toplevel));
reg_fun(intern(lit("ffi-make-call-desc"), user_package), func_n4(ffi_make_call_desc));
reg_fun(intern(lit("ffi-call"), user_package), func_n3(ffi_call_wrap));
reg_fun(intern(lit("cptr"), user_package), func_n1o(cptr_make, 0));
generated by cgit v1.2.3 (git 2.25.1) at 2025-04-22 10:33:32 +0000