Support for array types in ffi.

examples/ffi/gtk.janet

@@ -7,7 +7,7 @@
 (ffi/defbind
   gtk-application-new :ptr
   "Add docstrings as needed."
-  [a :ptr b :uint])
+  [title :string flags :uint])
 
 (ffi/defbind
   g-signal-connect-data :ulong
@@ -15,7 +15,7 @@
 
 (ffi/defbind
   g-application-run :int
-  [a :ptr b :int c :ptr])
+  [app :ptr argc :int argv :ptr])
 
 (ffi/defbind
   gtk-application-window-new :ptr
@@ -39,6 +39,18 @@
 
 (def cb (delay (ffi/trampoline :default)))
 
+(defn ffi/array
+  ``Convert a janet array to a buffer that can be passed to FFI functions.
+  For example, to create an array of type `char *` (array of c strings), one
+  could use `(ffi/array ["hello" "world"] :ptr)`. One needs to be careful that
+  array elements are not garbage collected though - the GC can't follow references
+  inside an arbitrary byte buffer.``
+  [arr ctype &opt buf]
+  (default buf @"")
+  (each el arr
+    (ffi/write ctype el buf))
+  buf)
+
 (defn on-active
   [app]
   (def window (gtk-application-window-new app))
@@ -53,4 +65,7 @@
   [&]
   (def app (gtk-application-new "org.janet-lang.example.HelloApp" 0))
   (g-signal-connect-data app "activate" (cb) on-active nil 1)
-  (g-application-run app 0 nil))
+  # manually build an array with ffi/write
+  # - we are responsible for preventing gc when the arg array is used
+  (def argv (ffi/array (dyn *args*) :string))
+  (g-application-run app (length (dyn *args*)) argv))

src/boot/boot.janet

@@ -1,5 +1,5 @@
 # The core janet library
-# Copyright 2021 © Calvin Rose
+# Copyright 2022 © Calvin Rose
 
 ###
 ###
@@ -3413,26 +3413,26 @@
     (def pc (frame :pc))
     (def sourcemap (in dasm :sourcemap))
     (var last-loc [-2 -2])
-    (print "\n  signal:     " (.signal))
+    (eprint "\n  signal:     " (.signal))
-    (print "  status:     " (fiber/status (.fiber)))
+    (eprint "  status:     " (fiber/status (.fiber)))
-    (print "  function:   " (dasm :name) " [" (in dasm :source "") "]")
+    (eprint "  function:   " (get dasm :name "<anonymous>") " [" (in dasm :source "") "]")
     (when-let [constants (dasm :constants)]
-      (printf "  constants:  %.4q" constants))
+      (eprintf "  constants:  %.4q" constants))
-    (printf "  slots:      %.4q\n" (frame :slots))
+    (eprintf "  slots:      %.4q\n" (frame :slots))
     (def padding (string/repeat " " 20))
     (loop [i :range [0 (length bytecode)]
            :let [instr (bytecode i)]]
-      (prin (if (= (tuple/type instr) :brackets) "*" " "))
+      (eprin (if (= (tuple/type instr) :brackets) "*" " "))
-      (prin (if (= i pc) "> " "  "))
+      (eprin (if (= i pc) "> " "  "))
-      (prinf "%.20s" (string (string/join (map string instr) " ") padding))
+      (eprinf "%.20s" (string (string/join (map string instr) " ") padding))
       (when sourcemap
         (let [[sl sc] (sourcemap i)
               loc [sl sc]]
           (when (not= loc last-loc)
             (set last-loc loc)
-            (prin " # line " sl ", column " sc))))
+            (eprin " # line " sl ", column " sc))))
-      (print))
+      (eprint))
-    (print))
+    (eprint))
 
   (defn .breakall
     "Set breakpoints on all instructions in the current function."
@@ -3441,7 +3441,7 @@
     (def bytecode (.bytecode n))
     (forv i 0 (length bytecode)
       (debug/fbreak fun i))
-    (print "Set " (length bytecode) " breakpoints in " fun))
+    (eprint "set " (length bytecode) " breakpoints in " fun))
 
   (defn .clearall
     "Clear all breakpoints on the current function."
@@ -3450,7 +3450,7 @@
     (def bytecode (.bytecode n))
     (forv i 0 (length bytecode)
       (debug/unfbreak fun i))
-    (print "Cleared " (length bytecode) " breakpoints in " fun)))
+    (eprint "cleared " (length bytecode) " breakpoints in " fun)))
 
 (defn .source
   "Show the source code for the function being debugged."
@@ -3458,7 +3458,7 @@
   (def frame (.frame n))
   (def s (frame :source))
   (def all-source (slurp s))
-  (print "\n" all-source "\n"))
+  (eprint "\n" all-source "\n"))
 
 (defn .break
   "Set breakpoint at the current pc."
@@ -3467,7 +3467,7 @@
   (def fun (frame :function))
   (def pc (frame :pc))
   (debug/fbreak fun pc)
-  (print "Set breakpoint in " fun " at pc=" pc))
+  (eprint "set breakpoint in " fun " at pc=" pc))
 
 (defn .clear
   "Clear the current breakpoint."
@@ -3476,7 +3476,7 @@
   (def fun (frame :function))
   (def pc (frame :pc))
   (debug/unfbreak fun pc)
-  (print "Cleared breakpoint in " fun " at pc=" pc))
+  (eprint "cleared breakpoint in " fun " at pc=" pc))
 
 (defn .next
   "Go to the next breakpoint."

src/core/ffi.c

@@ -56,6 +56,7 @@ typedef enum {
     JANET_FFI_TYPE_VOID,
     JANET_FFI_TYPE_BOOL,
     JANET_FFI_TYPE_PTR,
+    JANET_FFI_TYPE_STRING,
     JANET_FFI_TYPE_FLOAT,
     JANET_FFI_TYPE_DOUBLE,
     JANET_FFI_TYPE_INT8,
@@ -81,6 +82,7 @@ static const JanetFFIPrimInfo janet_ffi_type_info[] = {
     {0, 0}, /* JANET_FFI_TYPE_VOID */
     {sizeof(char), ALIGNOF(char)}, /* JANET_FFI_TYPE_BOOL */
     {sizeof(void *), ALIGNOF(void *)}, /* JANET_FFI_TYPE_PTR */
+    {sizeof(char *), ALIGNOF(char *)}, /* JANET_FFI_TYPE_STRING */
     {sizeof(float), ALIGNOF(float)}, /* JANET_FFI_TYPE_FLOAT */
     {sizeof(double), ALIGNOF(double)}, /* JANET_FFI_TYPE_DOUBLE */
     {sizeof(int8_t), ALIGNOF(int8_t)}, /* JANET_FFI_TYPE_INT8 */
@@ -97,6 +99,7 @@ static const JanetFFIPrimInfo janet_ffi_type_info[] = {
 struct JanetFFIType {
     JanetFFIStruct *st;
     JanetFFIPrimType prim;
+    size_t array_count;
 };
 
 typedef struct {
@@ -104,6 +107,7 @@ typedef struct {
     size_t offset;
 } JanetFFIStructMember;
 
+/* Also used to store array types */
 struct JanetFFIStruct {
     uint32_t size;
     uint32_t align;
@@ -219,14 +223,16 @@ static JanetFFIType prim_type(JanetFFIPrimType pt) {
     JanetFFIType t;
     t.prim = pt;
     t.st = NULL;
+    t.array_count = 0;
     return t;
 }
 
 static size_t type_size(JanetFFIType t) {
+    size_t count = t.array_count ? t.array_count : 1;
     if (t.prim == JANET_FFI_TYPE_STRUCT) {
-        return t.st->size;
+        return t.st->size * count;
     } else {
-        return janet_ffi_type_info[t.prim].size;
+        return janet_ffi_type_info[t.prim].size * count;
     }
 }
 
@@ -254,6 +260,7 @@ static JanetFFIPrimType decode_ffi_prim(const uint8_t *name) {
     if (!janet_cstrcmp(name, "void")) return JANET_FFI_TYPE_VOID;
     if (!janet_cstrcmp(name, "bool")) return JANET_FFI_TYPE_BOOL;
     if (!janet_cstrcmp(name, "ptr")) return JANET_FFI_TYPE_PTR;
+    if (!janet_cstrcmp(name, "string")) return JANET_FFI_TYPE_STRING;
     if (!janet_cstrcmp(name, "float")) return JANET_FFI_TYPE_FLOAT;
     if (!janet_cstrcmp(name, "double")) return JANET_FFI_TYPE_DOUBLE;
     if (!janet_cstrcmp(name, "int8")) return JANET_FFI_TYPE_INT8;
@@ -355,6 +362,11 @@ static JanetFFIStruct *build_struct_type(int32_t argc, const Janet *argv) {
         i++;
     }
     st->is_aligned = is_aligned;
+    if (is_aligned) {
+        st->size += st->align - 1;
+        st->size /= st->align;
+        st->size *= st->align;
+    }
     return st;
 }
 
@@ -371,7 +383,15 @@ static JanetFFIType decode_ffi_type(Janet x) {
     int32_t len;
     const Janet *els;
     if (janet_indexed_view(x, &els, &len)) {
-        ret.st = build_struct_type(len, els);
+        if (janet_checktype(x, JANET_ARRAY)) {
+            if (len != 2) janet_panicf("array type must be of form @[type count], got %v", x);
+            int32_t array_count = janet_getnat(els, 1);
+            if (array_count == 0) janet_panic("vla not supported");
+            ret = decode_ffi_type(els[0]);
+            ret.array_count = array_count;
+        } else {
+            ret.st = build_struct_type(len, els);
+        }
         return ret;
     } else {
         janet_panicf("bad native type %v", x);
@@ -380,11 +400,27 @@ static JanetFFIType decode_ffi_type(Janet x) {
 
 JANET_CORE_FN(cfun_ffi_struct,
               "(ffi/struct & types)",
-              "Create a struct type descriptor that can be used to pass structs into native functions. ") {
+              "Create a struct type definition that can be used to pass structs into native functions. ") {
     janet_arity(argc, 1, -1);
     return janet_wrap_abstract(build_struct_type(argc, argv));
 }
 
+JANET_CORE_FN(cfun_ffi_size,
+              "(ffi/size type)",
+              "Get the size of an ffi type in bytes.") {
+    janet_fixarity(argc, 1);
+    size_t size = type_size(decode_ffi_type(argv[0]));
+    return janet_wrap_number((double) size);
+}
+
+JANET_CORE_FN(cfun_ffi_align,
+              "(ffi/align type)",
+              "Get the align of an ffi type in bytes.") {
+    janet_fixarity(argc, 1);
+    size_t size = type_align(decode_ffi_type(argv[0]));
+    return janet_wrap_number((double) size);
+}
+
 static void *janet_ffi_getpointer(const Janet *argv, int32_t n) {
     switch (janet_type(argv[n])) {
         default:
@@ -411,6 +447,21 @@ static void *janet_ffi_getpointer(const Janet *argv, int32_t n) {
  * The alignment and space available is assumed to already be sufficient */
 static void janet_ffi_write_one(void *to, const Janet *argv, int32_t n, JanetFFIType type, int recur) {
     if (recur == 0) janet_panic("recursion too deep");
+    if (type.array_count) {
+        JanetFFIType el_type = type;
+        el_type.array_count = 0;
+        size_t el_size = type_size(el_type);
+        JanetView els = janet_getindexed(argv, n);
+        if ((size_t) els.len != type.array_count) {
+            janet_panicf("bad array length, expected %d, got %d", type.array_count, els.len);
+        }
+        char *cursor = to;
+        for (int32_t i = 0; i < els.len; i++) {
+            janet_ffi_write_one(cursor, els.items, i, el_type, recur - 1);
+            cursor += el_size;
+        }
+        return;
+    }
     switch (type.prim) {
         case JANET_FFI_TYPE_VOID:
             if (!janet_checktype(argv[n], JANET_NIL)) {
@@ -439,6 +490,9 @@ static void janet_ffi_write_one(void *to, const Janet *argv, int32_t n, JanetFFI
         case JANET_FFI_TYPE_PTR:
             ((void **)(to))[0] = janet_ffi_getpointer(argv, n);
             break;
+        case JANET_FFI_TYPE_STRING:
+            ((const char **)(to))[0] = janet_getcstring(argv, n);
+            break;
         case JANET_FFI_TYPE_BOOL:
             ((bool *)(to))[0] = janet_getboolean(argv, n);
             break;
@@ -474,6 +528,17 @@ static void janet_ffi_write_one(void *to, const Janet *argv, int32_t n, JanetFFI
  * size of the data is correct. */
 static Janet janet_ffi_read_one(const uint8_t *from, JanetFFIType type, int recur) {
     if (recur == 0) janet_panic("recursion too deep");
+    if (type.array_count) {
+        JanetFFIType el_type = type;
+        el_type.array_count = 0;
+        size_t el_size = type_size(el_type);
+        JanetArray *array = janet_array(type.array_count);
+        for (size_t i = 0; i < type.array_count; i++) {
+            janet_array_push(array, janet_ffi_read_one(from, el_type, recur - 1));
+            from += el_size;
+        }
+        return janet_wrap_array(array);
+    }
     switch (type.prim) {
         default:
         case JANET_FFI_TYPE_VOID:
@@ -495,6 +560,8 @@ static Janet janet_ffi_read_one(const uint8_t *from, JanetFFIType type, int recu
             void *ptr = ((void **)(from))[0];
             return (NULL == ptr) ? janet_wrap_nil() : janet_wrap_pointer(ptr);
         }
+        case JANET_FFI_TYPE_STRING:
+            return janet_cstringv(((char **)(from))[0]);
         case JANET_FFI_TYPE_BOOL:
             return janet_wrap_boolean(((bool *)(from))[0]);
         case JANET_FFI_TYPE_INT8:
@@ -537,6 +604,7 @@ static JanetFFIMapping void_mapping(void) {
 static JanetFFIWordSpec sysv64_classify(JanetFFIType type) {
     switch (type.prim) {
         case JANET_FFI_TYPE_PTR:
+        case JANET_FFI_TYPE_STRING:
         case JANET_FFI_TYPE_BOOL:
         case JANET_FFI_TYPE_INT8:
         case JANET_FFI_TYPE_INT16:
@@ -1163,6 +1231,8 @@ void janet_lib_ffi(JanetTable *env) {
         JANET_CORE_REG("ffi/struct", cfun_ffi_struct),
         JANET_CORE_REG("ffi/write", cfun_ffi_buffer_write),
         JANET_CORE_REG("ffi/read", cfun_ffi_buffer_read),
+        JANET_CORE_REG("ffi/size", cfun_ffi_size),
+        JANET_CORE_REG("ffi/align", cfun_ffi_align),
         JANET_CORE_REG("ffi/trampoline", cfun_ffi_get_callback_trampoline),
         JANET_REG_END
     };