From f34284f052caacc7e0873d8ea333d372e8e10125 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 20 Jun 2017 21:52:14 -0700
Subject: ffi: bool type.

* ffi.c (bool_s): New symbol variable.
(ffi_bool_put, ffi_bool_get): New static functions.
(ffi_type_compile): Handle (bool <type>) parametrized type.
(ffi_init_types): Register bool typedef for (bool uchar).
(ffi_init): Initialize bool_s.

* ffi.h (bool_s): Declared.

* txr.1: Documented.
---
 ffi.c | 33 +++++++++++++++++++++++++++++++++
 ffi.h |  2 ++
 txr.1 | 60 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 95 insertions(+)

diff --git a/ffi.c b/ffi.c
index fab5fa1e..51d938b9 100644
--- a/ffi.c
+++ b/ffi.c
@@ -126,6 +126,8 @@ val enum_s;
 
 val align_s;
 
+val bool_s;
+
 val ffi_type_s, ffi_call_desc_s, ffi_closure_s;
 
 static val ffi_typedef_hash;
@@ -1440,6 +1442,21 @@ static val ffi_generic_ubit_get(struct txr_ffi_type *tft,
   return ffi_ubit_get(tft, tmp, self);
 }
 
+static void ffi_bool_put(struct txr_ffi_type *tft, val truth,
+                         mem_t *dst, val self)
+{
+  val n = truth ? one : zero;
+  struct txr_ffi_type *tgtft = ffi_type_struct(tft->eltype);
+  tgtft->put(tft, n, dst, self); /* tft deliberate */
+}
+
+static val ffi_bool_get(struct txr_ffi_type *tft, mem_t *src, val self)
+{
+  struct txr_ffi_type *tgtft = ffi_type_struct(tft->eltype);
+  val n = tgtft->get(tft, src, self); /* tft deliberate */
+  return null(zerop(n));
+}
+
 #if !HAVE_LITTLE_ENDIAN
 
 static void ffi_i8_rput(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
@@ -3305,6 +3322,19 @@ val ffi_type_compile(val syntax)
         atft->align = al;
         return altype_copy;
       }
+    } else if (sym == bool_s) {
+      val type_syntax = cadr(syntax);
+      val type = ffi_type_compile(type_syntax);
+      val type_copy = ffi_type_copy(type);
+      struct txr_ffi_type *tft = ffi_type_struct(type_copy);
+      if (tft->eltype || tft->memb != 0)
+        uw_throwf(error_s, lit("~a: type ~s can't be basis for bool"),
+                  self, tft->syntax, nao);
+      tft->syntax = type_syntax;
+      tft->eltype = type;
+      tft->get = ffi_bool_get;
+      tft->put = ffi_bool_put;
+      return type_copy;
     }
 
     uw_throwf(error_s, lit("~a: unrecognized type operator: ~s"),
@@ -3653,6 +3683,8 @@ static void ffi_init_types(void)
                                             &ffi_type_void,
                                             ffi_void_put, ffi_void_get,
                                             0, 0));
+
+  ffi_typedef(bool_s, ffi_type_compile(cons(bool_s, cons(uchar_s, nil))));
 }
 
 static val ffi_type_lookup(val sym)
@@ -4994,6 +5026,7 @@ void ffi_init(void)
   bit_s = intern(lit("bit"), user_package);
   enum_s = intern(lit("enum"), user_package);
   align_s = intern(lit("align"), user_package);
+  bool_s = intern(lit("bool"), user_package);
   ffi_type_s = intern(lit("ffi-type"), user_package);
   ffi_call_desc_s = intern(lit("ffi-call-desc"), user_package);
   ffi_closure_s = intern(lit("ffi-closure"), user_package);
diff --git a/ffi.h b/ffi.h
index 37758d09..ee09ebf5 100644
--- a/ffi.h
+++ b/ffi.h
@@ -67,6 +67,8 @@ extern val enum_s;
 
 extern val align_s;
 
+extern val bool_s;
+
 extern val ffi_type_s, ffi_call_desc_s, ffi_closure_s;
 
 val ffi_type_compile(val syntax);
diff --git a/txr.1 b/txr.1
index 14c60d98..c0d35b4b 100644
--- a/txr.1
+++ b/txr.1
@@ -54026,6 +54026,16 @@ only \*(TL
 .code float
 type.
 
+.ccIP @ bool
+The type
+.code bool
+is a typedef name for the
+.code uchar
+instance of the parametrized
+.code bool
+type, which is to say,
+.codn "(bool uchar)" .
+
 .ccIP @ val
 The FFI
 .code val
@@ -54836,6 +54846,56 @@ object.
 
 The get semantics retrieves a Lisp value without freeing.
 
+.meIP (bool << type )
+The parametrized type
+.code bool
+can be derived from any integer or floating-point type. There is also an
+unparametrized
+.code bool
+which is a
+.code typedef
+for the type
+.codn "(bool uchar)" .
+
+The
+.code bool
+type family represents Boolean values, converting between a Lisp Boolean
+and foreign Boolean. A given instance of the
+.code bool
+type inherits all of its characteristics from
+.metn type ,
+such as its size, alignment and foreign representation. It alters the
+get and put semantics, however. The get semantics converts a foreign zero
+value of
+.meta type
+to the Lisp symbol
+.codn nil ,
+and all other values to the symbol
+.codn t .
+The put semantics converts the Lisp symbol
+.code nil
+to a foreign value of zero. Any other Lisp object converts to the foreign
+value one.
+
+The
+.code bool
+types are not integers, and cannot be used as the basis of bitfields:
+syntax like
+.code "(bits 3 (bool uint))"
+is not permitted. However, Boolean bitfields are possible when this
+syntax is turned inside out: the
+.code bool
+type can be derived from a bitfield type, as exemplified by
+.codn "(bool (bits 3 uint))" .
+This simply applies the above described Boolean conversion semantics to a
+three-bit field.  A zero/nonzero value of the field converts to
+.cod3 nil / t
+and a
+.code nil
+or
+.cod2 non- nil
+Lisp value converts to a 0 or 1 field value.
+
 .meIP ({ubit | sbit} << width )
 The
 .code ubit
-- 
cgit v1.2.3