diff --git a/lib/std/core/cextern.kk b/lib/std/core/cextern.kk new file mode 100644 index 000000000..1d932dc25 --- /dev/null +++ b/lib/std/core/cextern.kk @@ -0,0 +1,216 @@ +module std/core/cextern + +import std/num/int32 +import std/core/types +import std/core/int + +extern import + c header-file "inline/cextern.h" + +// A managed koka pointer to C memory +// Owned values can be freely passed around, captured in lambdas, escape their scope, etc. +pub alias owned-c = extern-owned + +// A borrowed koka pointer to C memory during a scope s +// Borrowed values are only guaranteed valid during their scope, should not escape the scope +// For example an `owned-c>` should only allow borrowed references to the middle of an array during a scope where the owned pointer will not be dropped +pub alias borrowed-c = extern-borrowed + +// A raw pointer to C memory +pub type c-pointer + +// An opaque type to designate c-array types in Koka +pub type c-array + +// A type alias for a null pointer of type `t` +pub alias c-null = c-pointer + +// The null pointer in C +pub inline extern cnull(): c-null + c inline "(intptr_t)0" + +// A null callback pointer +pub val null-cb = 0.intptr_t + +// Needs to be extern otherwise, the compiler will optimize out the function and not keep the reference alive +// Ensure that a reference is > 1 until after this point +pub extern owned/keepalive(^s: owned-c): <> () + "" + +// Release a reference (decref an owned reference) +pub fun owned/release(s: owned-c): <> () + () + +// Retain a reference (incref an owned reference) +pub extern owned/retain(s: owned-c): <> () + "" + +pub inline extern int/ptr(i: intptr_t): c-pointer + c inline "(intptr_t)#1" + +pub inline extern carray/intptr(c: c-array): intptr_t + c inline "#1" + +pub inline extern carray/ptr(c: c-array): c-pointer + c inline "#1" + +pub inline extern intptr/carray(c: intptr_t): c-array + c inline "#1" + +pub inline extern ptr/carray(c: c-pointer): c-array + c inline "#1" + +// Allow casting between different types of pointers +pub inline extern unsafe/cptr-cast(c: c-pointer): c-pointer + c inline "#1" + +// Allocate `n*size-of` bytes of memory using kk_malloc and return a pointer to the allocated memory +inline extern int/malloc(n: int32, size-of: int32): c-pointer + c inline "(kk_addr_t)kk_malloc(#1*#2, kk_context())" + +// Allocate `n*size-of` bytes of memory using C's malloc and return a pointer to the allocated memory +inline extern int/malloc-c(n: int32, size-of: int32): c-pointer + c inline "(kk_addr_t)malloc(#1*#2)" + +// Allocate a single element of type `t` using `kk_malloc` and return a managed pointer +// Type `t` should: +// - Be an opaque type in Koka corresponding to a C type (e.g. `pub type cstruct` with no members) +// - Have a `size-of` function that returns the size of the structure in bytes +pub inline fun single/malloc(?size-of: (c-null) -> int32): owned-c + int/malloc(1.int32, size-of(cnull())).c-own-extern + +// Allocate `n` elements of type `t` using `kk_malloc` and return a managed pointer to the array +// Type `t` should: +// - Be an opaque type in Koka corresponding to a C type (e.g. `pub type cstruct` with no members) +// - Have a `size-of` function that returns the size of the structure in bytes +pub inline fun array/malloc(n: int32, ?size-of: (c-null) -> int32): owned-c> + int/malloc(n, size-of(cnull())).c-own-extern + +// Allocate a single element of type `t` using C's `malloc` and return a managed pointer +// Type `t` should: +// - Be an opaque type in Koka corresponding to a C type (e.g. `pub type cstruct` with no members) +// - Have a `size-of` function that returns the size of the structure in bytes +pub inline fun single/malloc-c(?size-of: (c-null) -> int32): owned-c + int/malloc-c(1.int32, size-of(cnull())).c-own-free-calloc-extern + +// Allocate `n` elements of type `t` using C's `malloc` and return a managed pointer to the array +// Type `t` should: +// - Be an opaque type in Koka corresponding to a C type (e.g. `pub type cstruct` with no members) +// - Have a `size-of` function that returns the size of the structure in bytes +pub inline fun array/malloc-c(n: int32, ?size-of: (c-null) -> int32): owned-c> + int/malloc-c(n, size-of(cnull())).c-own-free-calloc-extern + +// !!!WARNING!!! UNSAFE API +// Allocate `n` elements of type `t` using `kk_malloc` and return a managed pointer to the array +// Type `t` should: +// - Be an opaque type in Koka corresponding to a C type (e.g. `pub type cstruct` with no members) +// - Have a `size-of` function that returns the size of the structure in bytes +// +// NOTES: +// Prefer using `array/malloc` or `single/malloc` instead of this function which return a managed pointer. +// Raw `c-pointer` should be used in low-level generated koka ffi functions since the pointer is unknown to be managed or not. +// Conversion routines for `owned-c` and `borrowed-c` then should be used to get the raw pointers to be used in the ffi functions +// Higher level apis to c libraries should then provide an interface using `owned-c` and `borrowed-c` instead of `c-pointer` +pub inline fun ptr/unsafe-malloc(n: int32, ?size-of: (c-null) -> int32): c-pointer + int/malloc(n, size-of(cnull())) + +// !!!WARNING!!! UNSAFE API +// Allocate `n` elements of type `t` using C's `malloc` and return a managed pointer to the array +// Type `t` should: +// - Be an opaque type in Koka corresponding to a C type (e.g. `pub type cstruct` with no members) +// - Have a `size-of` function that returns the size of the structure in bytes +// +// NOTES: +// Prefer using `array/malloc-c` or `single/malloc-c` instead of this function which return a managed pointer. +// Raw `c-pointer` should be used in low-level generated koka ffi functions since the pointer is unknown to be managed or not. +// Conversion routines for `owned-c` and `borrowed-c` then should be used to get the raw pointers to be used in the ffi functions +// Higher level apis to c libraries should then provide an interface using `owned-c` and `borrowed-c` instead of `c-pointer` +pub inline fun ptr/unsafe-malloc-c(n: int32, ?size-of: (c-null) -> int32): c-pointer + int/malloc-c(n, size-of(cnull())) + +// Transform a C ptr into a managed koka value, which will be freed by `kk_free` when koka's reference count reaches 0 +inline extern c-own-extern(c: c-pointer): owned-c + c inline "kk_cptr_raw_box(&kk_free_fun, (void *)#1, kk_context())" + +// Transform a C ptr into a managed koka value, which will be freed by C's `free` when koka's reference count reaches 0 +inline extern c-own-free-calloc-extern(c: c-pointer): owned-c + c inline "kk_cptr_raw_box(&kk_free_calloc, (void *)#1, kk_context())" + +// Transform a C ptr `c` into a koka value that holds the c reference without freeing it +// The pointer should be valid for the duration of the callback `f`. +inline extern c-borrow(c: c-pointer, f: forall borrowed-c -> e a): e a + c "kk_borrow_ptr" + +// !!!WARNING!!!: Extremely unsafe API (needed for `c-borrow`), get approval to use anywhere else. +inline extern unsafe-cast(b: c-pointer): borrowed-c + c inline "#1" + +// Transform an unmanaged C ptr into a managed koka reference to C memory +// Ensure the pointer is not going to be freed by C code, otherwise use `c-borrow` instead +// Also ensure the memory was allocated using `kk_malloc` +pub inline fun c-own(t: c-pointer): owned-c + t.c-own-extern + +// Transform an unmanaged C ptr into a managed koka reference to C memory +// Ensure the pointer is not going to be freed by C code, otherwise use `c-borrow` instead +// Also ensure the memory was allocated using C's `malloc` +pub fun c-own-free-calloc(t: c-pointer): owned-c + t.c-own-free-calloc-extern + +// Transform a koka `owned-c` managed pointer into a C ptr +// Keeps the koka reference alive during the scope of the callback `f` +pub inline extern owned/with-ptr(^t: owned-c, f: c-pointer -> e a): e a + c "kk_owned_with_ptr" + +// Transform a koka `borrowed-c` managed pointer into a C ptr +// Keeps the koka reference alive during the scope of the callback `f` +pub inline extern borrowed/with-ptr(^t: borrowed-c, f: c-pointer -> e a): e a + c "kk_borrowed_with_ptr" + +// !!!WARNING!!! Extremely UNSAFE API +// Get the raw C pointer from a `borrowed-c` managed pointer to use immediately in an ffi function +// This doesn't return a typed pointer, and accepts any boxed type as input, so it is very dangerous +// Use `borrowed/with-ptr` most of the time and +// `borrow/use-ffi-ptr` if directly passing to an safe ffi call +pub inline extern unsafe-borrowed-ffi-ptr-extern(c: borrowed-c): c-pointer + c inline "(kk_addr_t)kk_cptr_unbox_borrowed(#1, kk_context())" + +// !!!WARNING!!! UNSAFE API +// Get the raw C pointer from an `borrowed-c` managed pointer to use immediately in an ffi function +// Not safe to pass around Koka code +// However, since an immediate use is still within the scope of the `borrowed-c` it is safe +// This is due borrowed pointers being guaranteed to be valid during their whole scope (the lambda enclosing the call to this method) +// A similar api for `owned-c` is not possible since converting an owned pointer to a raw pointer could allow the owned pointer to be freed if this was its last use +// For owned pointers use `owned/with-ptr` instead +pub inline fun borrow/use-ffi-ptr(c: borrowed-c): c-pointer + c.unsafe-borrowed-ffi-ptr-extern + +// Transform a koka `owned-c` managed pointer to an array into a C ptr pointing to the element at index `idx` of type `t` and size `size-of(cnull())` +// Keeps the koka reference alive during the scope of the callback `f` +// This is guaranteed due to be this being an external function (`f` is not inlineable), and `t` being borrowed +pub inline extern offset/with-ptr(^t: owned-c>, idx: ssize_t, f: c-pointer -> e a, size-of: int32): e a + c "kk_owned_with_ptr_idx" + +// Transform a koka `owned-c` managed pointer to an array into a C ptr pointing to the element at index `idx` of type `t` and size `size-of(cnull())` +// Keeps the koka reference alive during the scope of the callback `f` +pub inline fun c-array/with-ptr(t: owned-c>, idx: ssize_t, f: forall borrowed-c -> e a, ?size-of: (c-null) -> int32): e a + offset/with-ptr(t, idx, fn(p) c-borrow(p, f), size-of(cnull())) + +// Transform an assumed pointer to a C string into a Koka string +// Copies the memory +pub inline extern ptr/to-string(ptr: c-pointer): string + c inline "kk_string_alloc_raw((const char *)#1, false, kk_context())" + +// Transform an assumed pointer to a C string of length len into a Koka string +// Copies the memory +// Assume the array is non-null terminated and adds the terminating character +pub inline extern strlen-ptr/to-string(ptr: c-pointer, len: int64): string + c inline "kk_string_alloc_raw_buff(#2, (char *)#1, false, kk_context())" + +// Borrows the c pointer to a koka managed string for the duration of the callback `f` +inline extern ptr/with-c-string(^s: string, f: c-pointer -> e a): e a + c "kk_with_c_string" + +// Borrows the c pointer to a koka managed string for the duration of the callback `f` +pub inline fun cptr/with-c-string(^s: string, f: forall borrowed-c -> e a): e a + with-c-string(s, fn(p) c-borrow(p, f)) diff --git a/lib/std/core/inline/cextern.h b/lib/std/core/inline/cextern.h new file mode 100644 index 000000000..babb042d6 --- /dev/null +++ b/lib/std/core/inline/cextern.h @@ -0,0 +1,37 @@ +// free memory using default C allocator +static void kk_free_calloc(void* p, kk_block_t* b, kk_context_t* _ctx) { + kk_unused(b); + kk_unused(_ctx); + free(p); +} + +static kk_box_t kk_owned_with_ptr(kk_box_t owned, kk_function_t f, kk_context_t* _ctx) { + kk_addr_t cptr = (kk_addr_t)kk_cptr_raw_unbox_borrowed(owned, kk_context()); + return kk_function_call(kk_box_t,(kk_function_t,kk_addr_t,kk_context_t*), f, (f, cptr, kk_context()), kk_context()); +} + +static kk_box_t kk_borrowed_with_ptr(kk_box_t borrowed, kk_function_t f, kk_context_t* _ctx) { + kk_addr_t cptr = (kk_addr_t)kk_cptr_unbox_borrowed(borrowed, kk_context()); + return kk_function_call(kk_box_t,(kk_function_t,kk_addr_t,kk_context_t*), f, (f, cptr, kk_context()), kk_context()); +} + +static kk_box_t kk_borrow_ptr(kk_addr_t cptr, kk_function_t f, kk_context_t* _ctx) { + kk_box_t ptr = kk_cptr_box((void *)cptr, kk_context()); + return kk_function_call(kk_box_t,(kk_function_t,kk_box_t,kk_context_t*), f, (f, ptr, kk_context()), kk_context()); +} + +static kk_box_t kk_owned_with_ptr_idx(kk_box_t owned, kk_ssize_t idx, kk_function_t f, int32_t size, kk_context_t* _ctx) { + uint8_t* cptr = (uint8_t*)kk_cptr_raw_unbox_borrowed(owned, kk_context()); + kk_addr_t cptr_idx = (kk_addr_t)(cptr + (idx*size)); + return kk_function_call(kk_box_t,(kk_function_t,kk_addr_t,kk_context_t*), f, (f, cptr_idx, kk_context()), kk_context()); +} + +static kk_string_t kk_string_alloc_raw_buff(kk_ssize_t len, char* s, bool free, kk_context_t* ctx){ + s[len] = 0; + return kk_string_alloc_raw_len(len, s, free, ctx); +} + +static kk_box_t kk_with_c_string(kk_string_t s, kk_function_t f, kk_context_t* _ctx){ + kk_addr_t cptr = (kk_addr_t)kk_string_cbuf_borrow(s, NULL, kk_context()); + return kk_function_call(kk_box_t,(kk_function_t,kk_addr_t,kk_context_t*), f, (f, cptr, kk_context()), kk_context()); +} \ No newline at end of file diff --git a/lib/std/core/types.kk b/lib/std/core/types.kk index 079fc4e17..670b3f2ed 100644 --- a/lib/std/core/types.kk +++ b/lib/std/core/types.kk @@ -101,6 +101,12 @@ pub value type float32 // See `module std/core/vector` for vector operations. pub type vector +// The type of an external (i.e. C) value where the memory is owned and managed by koka's refcounting +pub ref type extern-owned + +// The type of an external (i.e. C) value where the memory is borrowed and managed by external code +pub ref type extern-borrowed + // An any type. Used for external calls. pub type any diff --git a/src/Backend/C/Box.hs b/src/Backend/C/Box.hs index 638ab2200..9eb85137e 100644 --- a/src/Backend/C/Box.hs +++ b/src/Backend/C/Box.hs @@ -367,6 +367,7 @@ cType tp -> CFun (map (cType . snd) pars) (cType res) TApp t ts -> cType t + TCon (TypeCon nm _) | nm == nameTpExternOwned || nm == nameTpExternBorrowed -> CBox TCon c -> CData TVar v diff --git a/src/Backend/C/FromCore.hs b/src/Backend/C/FromCore.hs index 01fb96ae5..06f2cf47f 100644 --- a/src/Backend/C/FromCore.hs +++ b/src/Backend/C/FromCore.hs @@ -1292,6 +1292,10 @@ cTypeCon c then CPrim "kk_integer_t" else if (name == nameTpString) then CPrim "kk_string_t" + else if (name == nameTpExternOwned) + then CPrim "kk_box_t" + else if (name == nameTpExternBorrowed) + then CPrim "kk_box_t" else if (name == nameTpVector) then CPrim "kk_vector_t" else if (name == nameTpEvv) @@ -1302,6 +1306,10 @@ cTypeCon c then CPrim "kk_ssize_t" else if (name == nameTpIntPtrT) then CPrim "intptr_t" + else if (name == nameTpCPointer) + then CPrim "intptr_t" + else if (name == nameTpCArray) + then CPrim "intptr_t" else if (name == nameTpFloat) then CPrim "double" else if (name == nameTpBool) diff --git a/src/Backend/C/Parc.hs b/src/Backend/C/Parc.hs index 1319c32ae..47e0db85b 100644 --- a/src/Backend/C/Parc.hs +++ b/src/Backend/C/Parc.hs @@ -1029,7 +1029,7 @@ extractDataDefType tp isBoxType :: Type -> Bool -isBoxType (TCon (TypeCon name _)) = name == nameTpBox +isBoxType (TCon (TypeCon name _)) = name == nameTpBox || name == nameTpExternBorrowed || name == nameTpExternOwned isBoxType (TVar _) = True isBoxType (TSyn _ _ tp) = isBoxType tp isBoxType (TApp tp _) = isBoxType tp diff --git a/src/Common/NamePrim.hs b/src/Common/NamePrim.hs index b5950799b..86e06f665 100644 --- a/src/Common/NamePrim.hs +++ b/src/Common/NamePrim.hs @@ -125,6 +125,7 @@ module Common.NamePrim , makeTpHandled , nameTpHandled, nameTpHandled1, nameTpNHandled, nameTpNHandled1 , nameTpMarker + , nameTpExternOwned, nameTpExternBorrowed, nameTpCPointer, nameTpCArray {- , nameTpOperation, nameYieldOp , nameTpCps, nameTpYld, nameTpCont @@ -376,6 +377,11 @@ nameByref = coreTypesName "@byref" namePredHeapDiv = coreTypesName "hdiv" namePredEffDiv = coreTypesName "ediv" +nameTpCPointer = qualify (newModuleName "std/core/cextern") (newName "c-pointer") +nameTpCArray = qualify (newModuleName "std/core/cextern") (newName "c-array") +nameTpExternOwned = coreTypesName "extern-owned" +nameTpExternBorrowed = coreTypesName "extern-borrowed" + nameTpRef = coreTypesName "ref" nameTpLocalVar = coreTypesName "local-var" nameTpLocal = coreTypesName "local" diff --git a/test/cgen/extern.h b/test/cgen/extern.h new file mode 100644 index 000000000..1635efb8c --- /dev/null +++ b/test/cgen/extern.h @@ -0,0 +1,3 @@ +typedef struct c_struct_s { + int xint; +} c_struct_t; \ No newline at end of file diff --git a/test/cgen/extern.kk b/test/cgen/extern.kk new file mode 100644 index 000000000..9b86bcc0a --- /dev/null +++ b/test/cgen/extern.kk @@ -0,0 +1,60 @@ +import std/core/cextern +import std/num/int32 + +extern import + c file "extern.h" + +pub type c-struct; +pub alias kstructo = owned-c; +pub alias kstructoa = owned-c>; +pub alias kstructb = borrowed-c; + +pub extern size-of(c: c-null): int32 + c inline "sizeof(c_struct_t)" + +inline extern ptr/xint(s: c-pointer): int32 + c inline "((c_struct_t*)#1)->xint" + +inline extern ptr/set-xint(s: c-pointer, x: int32): () + c inline "((c_struct_t*)#1)->xint = #2" + +pub fun kstructo(): kstructo + malloc() + +pub fun kstructoc(): kstructo + malloc-c() + +pub fun kstruct-array(n: int): kstructoa + malloc(n.int32) + +pub inline fun kstruct/xint(^s: kstructo): int32 + s.with-ptr(xint) + +pub inline fun kstructb/xint(^s: kstructb): int32 + s.with-ptr(xint) + +pub fun set-xintf(x: int32): ((c-pointer) -> ()) + fn(p) set-xint(p, x) + +pub inline fun kstruct/set-xint(^s: kstructo, x: int32): () + s.with-ptr(set-xintf(x)) + +pub inline fun kstructb/set-xint(^s: kstructb, x: int32): () + s.with-ptr(set-xintf(x)) + +fun main() + val s = kstructo() + set-xint(s, 42.int32) + println(xint(s)) + + val s2 = kstructoc() + set-xint(s2, 43.int32) + println(xint(s2)) + + val ss = kstruct-array(10) + for(10) fn(i) + ss.with-ptr(i.ssize_t) fn(b) + b.set-xint(i.int32) + for(10) fn(i) + ss.with-ptr(i.ssize_t) fn(b) + println(b.xint)