diff options
| -rw-r--r-- | ffi.c | 45 | ||||
| -rw-r--r-- | ffi.h | 1 | ||||
| -rw-r--r-- | lisplib.c | 1 | ||||
| -rw-r--r-- | share/txr/stdlib/ffi.tl | 7 | ||||
| -rw-r--r-- | txr.1 | 128 |
5 files changed, 182 insertions, 0 deletions
@@ -5361,6 +5361,50 @@ val union_out(val uni, val memb, val memb_obj) return memb_obj; } +val make_zstruct(val type, struct args *args) +{ + val self = lit("make-zstruct"); + struct txr_ffi_type *tft = ffi_type_struct_checked(type); + val pairs = args_get_list(args); + args_decl(ms_args, 0); + val strct = make_struct(tft->lt, nil, ms_args); + mem_t *zbuf; + char *inited = coerce(char *, zalloca(tft->nelem)); + cnum i, largest; + + if (!tft->memb) + uw_throwf(error_s, lit("~a: ~s isn't a struct type"), self, type, nao); + + for (i = largest = 0; i < tft->nelem; i++) { + cnum size =tft->memb[i].mtft->size; + if (size > largest) + largest = size; + } + + zbuf = coerce(mem_t *, zalloca(largest)); + + while (pairs) { + val sym = pop(&pairs); + val initval = pop(&pairs); + + slotset(strct, sym, initval); + + for (i = 0; i < tft->nelem; i++) + if (tft->memb[i].mname == sym) + inited[i] = 1; + } + + for (i = 0; i < tft->nelem; i++) { + if (!inited[i]) { + struct smemb *m = &tft->memb[i]; + val slsym = m->mname; + val initval = m->mtft->get(m->mtft, zbuf, self); + slotset(strct, slsym, initval); + } + } + + return strct; +} void ffi_init(void) { @@ -5488,6 +5532,7 @@ void ffi_init(void) reg_fun(intern(lit("union-put"), user_package), func_n3(union_put)); reg_fun(intern(lit("union-in"), user_package), func_n3(union_in)); reg_fun(intern(lit("union-out"), user_package), func_n3(union_out)); + reg_fun(intern(lit("make-zstruct"), user_package), func_n1v(make_zstruct)); ffi_typedef_hash = make_hash(nil, nil, nil); ffi_init_types(); ffi_init_extra_types(); @@ -130,4 +130,5 @@ val union_get(val uni, val memb); val union_put(val uni, val memb, val newval); val union_in(val uni, val memb, val memb_obj); val union_out(val uni, val memb, val memb_obj); +val make_zstruct(val type, struct args *args); void ffi_init(void); @@ -527,6 +527,7 @@ static val ffi_set_entries(val dlt, val fun) lit("deffi-sym"), lit("deffi-var"), lit("typedef"), lit("sizeof"), lit("alignof"), lit("offsetof"), lit("arraysize"), lit("elemsize"), lit("elemtype"), lit("ffi"), lit("carray-ref"), lit("carray-sub"), + lit("znew"), nil }; set_dlt_entries(dlt, name, fun); diff --git a/share/txr/stdlib/ffi.tl b/share/txr/stdlib/ffi.tl index a430f777..6cf1bf5a 100644 --- a/share/txr/stdlib/ffi.tl +++ b/share/txr/stdlib/ffi.tl @@ -148,3 +148,10 @@ (define-place-macro carray-sub (carray : (from 0) (to t)) ^(sub ,carray ,from ,to)) + +(defmacro znew (type . pairs) + (if (oddp (length pairs)) + (throwf 'eval-error "~s: slot initform arguments must occur pairwise" + 'znew)) + (let ((qpairs (mappend (aret ^(',@1 ,@2)) (tuples 2 pairs)))) + ^(make-zstruct (ffi ,type) ,*qpairs))) @@ -54687,6 +54687,12 @@ and .code bit compound type operators. +See also: the +.code make-zstruct +function and the +.code znew +macro. + .meIP (union < name >> {( slot << type )}*) The FFI .code union @@ -56781,6 +56787,128 @@ following equivalence holds: (ffi expr) <--> (ffi-type-compile 'expr) .cble +.coNP Function @ make-zstruct +.synb +.mets (make-zstruct < type >> { slot-sym << init-value }*) +.syne +.desc +The +.code make-zstruct +function provides a convenient means of instantiating a structure +for use in foreign function calls, imitating a pattern of initialization +often seen in the C language. It instantiates a Lisp +.code struct +by conversion of zero-filled memory through FFI, thus creating a Lisp +structure which appears zero-filled when converted to the foreign representation. + +This simplifies application code, which is spared from providing individual +slot initializations which have this effect. + +The +.meta type +argument must be a compiled FFI +.code struct +type. The remaining arguments must occur pairwise. Each +.meta slot-sym +argument must be a symbol naming a slot in the FFI +.code struct +type. The +.meta init-value +argument which follows it specifies the value for that +slot. + +The +.code make-zstruct +function operates as follows. Firstly, the Lisp +.code struct +type is retrieved which corresponds to the FFI type given by +.metn type . +A new instance of the Lisp type is instantiated, as if by +a one-argument call to +.codn make-struct . +Next, each members indicated by a +.meta slot-sym +argument is set to the corresponding +.metn init-value . +Finally, each member of the struct which is not initialized via +.meta slot-sym +and +.meta init-value +pair, and which is known to the FFI type, is re-initialized by a conversion +from a foreign object of all-zero bits to a Lisp value. +argument. The +.code struct +object is then returned. + +Note: the +.code znew +macro provides a less verbose notation based on +.codn make-zstruct . + +Note: slots which are not known to the FFI +.code struct +type may be initialized by +.codn make-zstruct . +Each +.meta slot-sym +must be a slot of the Lisp +.code struct +type; but need not be declared as a member in the FFI +.code struct +type. + +.coNP Macro @ znew +.synb +.mets (znew < type-syntax >> { slot-sym << init-value }*) +.syne +.desc +The +.code znew +macro provides a convenient way of using +.codn make-zstruct , +using syntax which resembles that of the +.code new +macro. + +The +.code znew +macro generates a +.code make-zstruct +call, arranging for the +.meta type-syntax +argument to be compiled to a FFI type object, and +applies quoting to every +.meta slot-sym +argument. + + +The following equivalence holds: + +.cblk + (znew s a i b j ...) <--> (make-zstruct (ffi s) 'a i 'b j ...) +.cble + +.TP* Example + +Given the following FFI type definition + +.cblk + (typedef foo (struct foo (a (cptr bar)) (b uint) (c bool))) +.cble + +the following results are observed: + +.cblk + ;; ordinary instantiation + (new foo) -> #S(foo a nil b nil c nil) + + ;; Under znew, a is null cptr of correct type: + (znew foo) -> #S(foo a #<cptr bar: 0> b 0 c nil) + + ;; value of b is specified; others come from zeros: + (znew foo b 42) -> #S(foo a #<cptr bar: 0> b 42 c nil) +.cble + .coNP Function @ make-union .synb .mets (make-union < type >> [ initval <> [ member ]]) |