From 04d937d72aae44ccf0157a0a092f5ad67a4011b7 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Thu, 4 May 2017 23:22:08 -0700
Subject: ffi: functions for type-system-driven buffer coding.

* ffi.c (ffi_put_into, ffi_put, ffi_in, ffi_get, ffi_out):
New functions.
(ffi_init): ffi-put-into, ffi-put, ffi-in, ffi-get, ffi-out:
intrinsics registered.

* ffi.h (ffi_put_into, ffi_put, ffi_in, ffi_get, ffi_out):
Declared.
---
 ffi.c | 61 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 ffi.h |  5 +++++
 2 files changed, 66 insertions(+)

diff --git a/ffi.c b/ffi.c
index a079ceaf..ffeb3987 100644
--- a/ffi.c
+++ b/ffi.c
@@ -1849,6 +1849,62 @@ val ffi_typedef(val name, val type)
   return sethash(ffi_typedef_hash, name, type);
 }
 
+val ffi_put_into(val dstbuf, val obj, val type)
+{
+  val self = lit("ffi-put-into");
+  struct txr_ffi_type *tft = ffi_type_struct_checked(type);
+  mem_t *dst = buf_get(dstbuf, self);
+  if (lt(length_buf(dstbuf), num_fast(tft->size)))
+    uw_throwf(lit("~a: buffer ~s is too small for type ~s"),
+              self, dstbuf, type, nao);
+  tft->put(tft, obj, dst, self);
+  return dstbuf;
+}
+
+val ffi_put(val obj, val type)
+{
+  val self = lit("ffi-put");
+  struct txr_ffi_type *tft = ffi_type_struct_checked(type);
+  val buf = make_buf(num_fast(tft->size), zero, nil);
+  mem_t *dst = buf_get(buf, self);
+  tft->put(tft, obj, dst, self);
+  return buf;
+}
+
+val ffi_in(val srcbuf, val obj, val type)
+{
+  val self = lit("ffi-in");
+  struct txr_ffi_type *tft = ffi_type_struct_checked(type);
+  mem_t *src = buf_get(srcbuf, self);
+  if (lt(length_buf(srcbuf), num_fast(tft->size)))
+    uw_throwf(lit("~a: buffer ~s is too small for type ~s"),
+              self, srcbuf, type, nao);
+  return tft->in(tft, src, obj, self);
+}
+
+val ffi_get(val srcbuf, val type)
+{
+  val self = lit("ffi-get");
+  struct txr_ffi_type *tft = ffi_type_struct_checked(type);
+  mem_t *src = buf_get(srcbuf, self);
+  if (lt(length_buf(srcbuf), num_fast(tft->size)))
+    uw_throwf(lit("~a: buffer ~s is too small for type ~s"),
+              self, srcbuf, type, nao);
+  return tft->get(tft, src, self);
+}
+
+val ffi_out(val dstbuf, val obj, val type, val copy_p)
+{
+  val self = lit("ffi-out");
+  struct txr_ffi_type *tft = ffi_type_struct_checked(type);
+  mem_t *dst = buf_get(dstbuf, self);
+  if (lt(length_buf(dstbuf), num_fast(tft->size)))
+    uw_throwf(lit("~a: buffer ~s is too small for type ~s"),
+              self, dstbuf, type, nao);
+  tft->out(tft, copy_p != nil, obj, dst, self);
+  return dstbuf;
+}
+
 void ffi_init(void)
 {
   prot1(&ffi_typedef_hash);
@@ -1898,6 +1954,11 @@ void ffi_init(void)
   reg_fun(intern(lit("ffi-make-closure"), user_package), func_n2(ffi_make_closure));
   reg_fun(intern(lit("cptr"), user_package), func_n1o(cptr_make, 0));
   reg_fun(intern(lit("ffi-typedef"), user_package), func_n2(ffi_typedef));
+  reg_fun(intern(lit("ffi-put-into"), user_package), func_n3(ffi_put_into));
+  reg_fun(intern(lit("ffi-put"), user_package), func_n2(ffi_put));
+  reg_fun(intern(lit("ffi-in"), user_package), func_n3(ffi_in));
+  reg_fun(intern(lit("ffi-get"), user_package), func_n2(ffi_get));
+  reg_fun(intern(lit("ffi-out"), user_package), func_n4(ffi_out));
   reg_varl(intern(lit("cptr-null"), user_package), cptr(0));
   ffi_typedef_hash = make_hash(nil, nil, nil);
   ffi_init_types();
diff --git a/ffi.h b/ffi.h
index c598044f..bd8b61fb 100644
--- a/ffi.h
+++ b/ffi.h
@@ -57,4 +57,9 @@ val ffi_make_closure(val fun, val call_desc);
 mem_t *ffi_closure_get_fptr(val closure);
 val ffi_call_wrap(val ffi_call_desc, val fptr, val args);
 val ffi_typedef(val name, val type);
+val ffi_put_into(val dstbuf, val obj, val type);
+val ffi_put(val obj, val type);
+val ffi_in(val srcbuf, val obj, val type);
+val ffi_get(val srcbuf, val type);
+val ffi_out(val dstbuf, val obj, val type, val copy_p);
 void ffi_init(void);
-- 
cgit v1.2.3