mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2024-11-24 17:27:18 +00:00
Code Issues 1 Releases Wiki Activity

Support for array types in ffi.

Browse Source
This commit is contained in:
Calvin Rose 2022-06-19 08:03:07 -05:00
parent 20511cf608
commit a6f93efd39
3 changed files with 109 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
examples/ffi/gtk.janet
View File

@ -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))

34
src/boot/boot.janet
View File

@ -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))
(print " status: " (fiber/status (.fiber)))
(print " function: " (dasm :name) " [" (in dasm :source "") "]")
(eprint "\n signal: " (.signal))
(eprint " status: " (fiber/status (.fiber)))
(eprint " function: " (get dasm :name "<anonymous>") " [" (in dasm :source "") "]")
(when-let [constants (dasm :constants)]
(printf " constants: %.4q" constants))
(printf " slots: %.4q\n" (frame :slots))
(eprintf " constants: %.4q" constants))
(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) "*" " "))
(prin (if (= i pc) "> " " "))
(prinf "%.20s" (string (string/join (map string instr) " ") padding))
(eprin (if (= (tuple/type instr) :brackets) "*" " "))
(eprin (if (= i pc) "> " " "))
(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))))
(print))
(print))
(eprin " # line " sl ", column " sc))))
(eprint))
(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."

78
src/core/ffi.c
View File

@ -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
};