add stdbool foreign type

boot/pb/equates.h

@@ -1,4 +1,4 @@
-/* equates.h for Chez Scheme Version 10.1.0-pre-release.2 */
+/* equates.h for Chez Scheme Version 10.1.0-pre-release.3 */
 
 /* Do not edit this file.  It is automatically generated and */
 /* specifically tailored to the version of Chez Scheme named */
@@ -1014,7 +1014,7 @@ typedef uint64_t U64;
 #define rtd_sealed 0x4
 #define sbwp (ptr)0x4E
 #define scaled_shot_1_shot_flag -0x8
-#define scheme_version 0xA010002
+#define scheme_version 0xA010003
 #define seginfo_generation_disp 0x1
 #define seginfo_list_bits_disp 0x8
 #define seginfo_space_disp 0x0
@@ -1094,6 +1094,7 @@ typedef uint64_t U64;
 #define stack_slop 0x400
 #define stack_word_alignment 0x1
 #define static_generation 0x7
+#define stdbool_bits 0x8
 #define stencil_vector_data_disp 0x9
 #define stencil_vector_mask_bits 0x3A
 #define stencil_vector_mask_offset 0x6

boot/pb/scheme.h

@@ -1,4 +1,4 @@
-/* scheme.h for Chez Scheme Version 10.1.0-pre-release.2 (pb) */
+/* scheme.h for Chez Scheme Version 10.1.0-pre-release.3 (pb) */
 
 /* Do not edit this file.  It is automatically generated and */
 /* specifically tailored to the version of Chez Scheme named */
@@ -40,7 +40,7 @@
 #endif
 
 /* Chez Scheme Version and machine type */
-#define VERSION "10.1.0-pre-release.2"
+#define VERSION "10.1.0-pre-release.3"
 #define MACHINE_TYPE "pb"
 
 /* Integer typedefs */

csug/foreign.stex

@@ -492,6 +492,12 @@ Transmission of fixnums is slightly faster than transmission of
 \scheme{#f} is converted to 0; all other objects are converted to 1.
 The argument is passed to C as an \scheme{int}.
 
+\foreigntype{\scheme{stdbool}}
+\index{\scheme{stdbool}}Any Scheme object may be passed as a boolean.
+\scheme{#f} is converted to 0; all other objects are converted to 1.
+The argument is passed to C as a \scheme{bool} defined by the the host
+machine's \scheme{stdbool.h} include file.
+
 \foreigntype{\scheme{char}}
 \index{\scheme{char}}Only Scheme characters with Unicode scalar values
 in the range 0 through 255 are valid \scheme{char} parameters.
@@ -772,6 +778,12 @@ fixed-size type above, depending on the size of a C pointer.
 into a Scheme boolean.
 0 is converted to \scheme{#f}; all other values are converted to \scheme{#t}.
 
+\foreigntype{\scheme{stdbool}}
+\index{\scheme{stdbool}}This type converts a C \scheme{bool} return value
+into a Scheme boolean, where \scheme{bool} is from the host machine's \scheme{stdbool.h}
+include file.
+0 is converted to \scheme{#f}; all other values are converted to \scheme{#t}.
+
 \foreigntype{\scheme{char}}
 \index{\scheme{char}}This type converts a C \scheme{unsigned char} return value
 into a Scheme character, as if via \scheme{integer->char}.
@@ -1427,8 +1439,9 @@ Several additional machine-dependent types are recognized:
 \begin{itemize}
 \item \scheme{iptr},
 \item \scheme{uptr},
-\item \scheme{fixnum}, and
-\item \scheme{boolean}.
+\item \scheme{fixnum},
+\item \scheme{boolean}, and
+\item \scheme{stdbool}.
 \end{itemize}
 
 \scheme{uptr} is equivalent to \scheme{void*}; both are treated as
@@ -1439,6 +1452,9 @@ to the fixnum range.
 \scheme{boolean} is treated as an \scheme{int}, with zero
 converted to the Scheme value \scheme{#f} and all
 other values converted to \scheme{#t}.
+\scheme{stdbool} is treated as an \scheme{bool} from \scheme{stdbool.h}, with zero
+converted to the Scheme value \scheme{#f} and all
+other values converted to \scheme{#t}.
 
 Finally, several fixed-sized types are also supported:
 
@@ -1482,7 +1498,7 @@ to be stored, one of those listed in the description of
 \scheme{foreign-ref} above.
 Scheme characters are converted to type \scheme{char} or \scheme{wchar_t}
 as if via \scheme{char->integer}.
-For type \scheme{boolean}, Scheme \scheme{#f} is converted to the
+For type \scheme{boolean} or \scheme{stdbool}, Scheme \scheme{#f} is converted to the
 \scheme{int} 0, and any other Scheme object is converted to 1.
 
 \var{address} must be an exact integer in the range $-2^{w-1}$ through

mats/foreign.ms

@@ -933,6 +933,7 @@
   (equal? (foreign-sizeof 'unsigned-long) (foreign-sizeof 'long))
   (equal? (foreign-sizeof 'unsigned-long-long) (foreign-sizeof 'long-long))
   (equal? (foreign-sizeof 'boolean) (foreign-sizeof 'int))
+  (equal? (foreign-sizeof 'stdbool) (foreign-sizeof 'stdbool))
   (equal? (foreign-sizeof 'fixnum) (foreign-sizeof 'iptr))
   (equal? (foreign-sizeof 'scheme-object) (foreign-sizeof 'void*))
   (equal? (foreign-sizeof 'ptr) (foreign-sizeof 'void*))
@@ -2594,6 +2595,19 @@
     (and
       (eqv? (Srvtest_boolean Frvtest_boolean "abcdefg") #t)
       (eqv? (Srvtest_boolean Frvtest_boolean "gfedcba") #f)))
+  (let ()
+    (define Frvtest_stdbool
+      (foreign-callable
+        (lambda (x) (equal? x "abCDEfg"))
+        (scheme-object)
+        stdbool))
+    (define Srvtest_stdbool
+      (foreign-procedure "Srvtest_stdbool"
+        (scheme-object scheme-object)
+        stdbool))
+    (and
+      (eqv? (Srvtest_stdbool Frvtest_stdbool "abCDEfg") #t)
+      (eqv? (Srvtest_stdbool Frvtest_stdbool "gfEDCba") #f)))
   (let ()
     (define Frvtest_fixnum
       (foreign-callable

mats/foreign3.c

@@ -31,6 +31,9 @@
 #include "scheme.h"
 #endif
 
+/* Standard in C99, but widely available in environments for earlier C dialects: */
+#include <stdbool.h>
+
 EXPORT int chk_data(void) {
     static char c[10]="ABCDEFGH";
 
@@ -178,6 +181,10 @@ EXPORT char Srvtest_char(ptr code, ptr x1) {
     return (*((char (*)(ptr))Sforeign_callable_entry_point(code)))(x1);
 }
 
+EXPORT bool Srvtest_stdbool(ptr code, ptr x1) {
+    return (*((bool (*)(ptr))Sforeign_callable_entry_point(code)))(x1);
+}
+
 #ifdef _WIN32
 EXPORT int __stdcall sum_stdcall(int a, int b) {
     return a + b;

mats/ftype.ms

@@ -443,6 +443,7 @@
         (uptr . ,(if (< (fixnum-width) 32) "uint32_t" "uint64_t"))
         (fixnum . ,(if (< (fixnum-width) 32) "int32_t" "int64_t"))
         (boolean . "int")
+        (stdbool . "int8_t")
         (integer-8 . "int8_t")
         (unsigned-8 . "uint8_t")
         (integer-16 . "int16_t")
@@ -723,7 +724,8 @@
            [a15 fixnum]
            [a16 iptr]
            [a17 uptr]
-           [a18 void*]))
+           [a18 void*]
+           [a19 stdbool]))
        (define a (make-ftype-pointer A (foreign-alloc (ftype-sizeof A))))
        (free-after a
          (ftype-set! A (a1) a 3.5)
@@ -744,6 +746,7 @@
          (ftype-set! A (a16) a -30004)
          (ftype-set! A (a17) a #xabcdef07)
          (ftype-set! A (a18) a 25000)
+         (ftype-set! A (a19) a 'howdy)
          (list
            (ftype-ref A (a1) a)
            (ftype-ref A (a2) a)
@@ -762,7 +765,8 @@
            (ftype-ref A (a15) a)
            (ftype-ref A (a16) a)
            (ftype-ref A (a17) a)
-           (ftype-ref A (a18) a))))
+           (ftype-ref A (a18) a)
+           (ftype-ref A (a19) a))))
     `(3.5
       -4.5
       -30000
@@ -780,7 +784,8 @@
       ,(most-positive-fixnum)
       -30004
       #xabcdef07
-      25000))
+      25000
+      #t))
 
   (begin
     (define-ftype A
@@ -4022,7 +4027,8 @@
              [a15 fixnum]
              [a16 iptr]
              [a17 uptr]
-             [a18 void*])))
+             [a18 void*]
+             [a19 stdbool])))
        (define a (make-ftype-pointer A (foreign-alloc (ftype-sizeof A))))
        (free-after a
          (ftype-set! A (a1) a 3.5)
@@ -4043,6 +4049,7 @@
          (ftype-set! A (a16) a -30004)
          (ftype-set! A (a17) a #xabcdef07)
          (ftype-set! A (a18) a 25000)
+         (ftype-set! A (a19) a 'howdy)
          (list
            (ftype-ref A (a1) a)
            (ftype-ref A (a2) a)
@@ -4061,7 +4068,8 @@
            (ftype-ref A (a15) a)
            (ftype-ref A (a16) a)
            (ftype-ref A (a17) a)
-           (ftype-ref A (a18) a))))
+           (ftype-ref A (a18) a)
+           (ftype-ref A (a19) a))))
     `(3.5
       -4.5
       -30000
@@ -4079,7 +4087,8 @@
       ,(most-positive-fixnum)
       -30004
       #xabcdef07
-      25000))
+      25000
+      #t))
   (equal?
     (let ()
        (define-ftype A
@@ -4102,7 +4111,8 @@
              [a15 fixnum]
              [a16 iptr]
              [a17 uptr]
-             [a18 void*])))
+             [a18 void*]
+             [a19 stdbool])))
        (define a (make-ftype-pointer A (foreign-alloc (ftype-sizeof A))))
        (free-after a
          (ftype-set! A (a1) a 3.5)
@@ -4123,6 +4133,7 @@
          (ftype-set! A (a16) a -30004)
          (ftype-set! A (a17) a #xabcdef07)
          (ftype-set! A (a18) a 25000)
+         (ftype-set! A (a19) a 'howdy)
          (list
            (ftype-ref A (a1) a)
            (ftype-ref A (a2) a)
@@ -4141,7 +4152,8 @@
            (ftype-ref A (a15) a)
            (ftype-ref A (a16) a)
            (ftype-ref A (a17) a)
-           (ftype-ref A (a18) a))))
+           (ftype-ref A (a18) a)
+           (ftype-ref A (a19) a))))
     `(3.5
       -4.5
       -30000
@@ -4159,7 +4171,8 @@
       ,(most-positive-fixnum)
       -30004
       #xabcdef07
-      25000))
+      25000
+      #t))
   (equal?
     (let ()
        (define-ftype A
@@ -4182,7 +4195,8 @@
              [a15 fixnum]
              [a16 iptr]
              [a17 uptr]
-             [a18 void*])))
+             [a18 void*]
+             [a19 stdbool])))
        (define a (make-ftype-pointer A (foreign-alloc (ftype-sizeof A))))
        (free-after a
          (ftype-set! A (a1) a 3.5)
@@ -4203,6 +4217,7 @@
          (ftype-set! A (a16) a -30004)
          (ftype-set! A (a17) a #xabcdef07)
          (ftype-set! A (a18) a 25000)
+         (ftype-set! A (a19) a 'howdy)
          (list
            (ftype-ref A (a1) a)
            (ftype-ref A (a2) a)
@@ -4221,7 +4236,8 @@
            (ftype-ref A (a15) a)
            (ftype-ref A (a16) a)
            (ftype-ref A (a17) a)
-           (ftype-ref A (a18) a))))
+           (ftype-ref A (a18) a)
+           (ftype-ref A (a19) a))))
     `(3.5
       -4.5
       -30000
@@ -4239,7 +4255,8 @@
       ,(most-positive-fixnum)
       -30004
       #xabcdef07
-      25000))
+      25000
+      #t))
 
  ; ----------------
   (begin
@@ -5667,7 +5684,8 @@
           [a15 fixnum]
           [a16 iptr]
           [a17 uptr]
-          [a18 void*])))
+          [a18 void*]
+          [a19 stdbool])))
     #t)
   (equivalent-expansion?
     (parameterize ([optimize-level 3] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
@@ -5691,6 +5709,7 @@
            (ftype-ref A (a16) x)
            (ftype-ref A (a17) x)
            (ftype-ref A (a18) x)
+           (ftype-ref A (a19) x)
            x)))
     '(lambda (x) x))
   (equivalent-expansion?
@@ -5715,6 +5734,7 @@
            (ftype-&ref A (a16) x)
            (ftype-&ref A (a17) x)
            (ftype-&ref A (a18) x)
+           (ftype-&ref A (a19) x)
            x)))
     '(lambda (x) x))
   (begin
@@ -5738,7 +5758,8 @@
           [a15 fixnum]
           [a16 iptr]
           [a17 uptr]
-          [a18 void*])))
+          [a18 void*]
+          [a19 stdbool])))
     #t)
   (equivalent-expansion?
     (parameterize ([optimize-level 3] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
@@ -5762,6 +5783,7 @@
            (ftype-ref A (a16) x)
            (ftype-ref A (a17) x)
            (ftype-ref A (a18) x)
+           (ftype-ref A (a19) x)
            x)))
     '(lambda (x) x))
   (equivalent-expansion?
@@ -5786,6 +5808,7 @@
            (ftype-&ref A (a16) x)
            (ftype-&ref A (a17) x)
            (ftype-&ref A (a18) x)
+           (ftype-&ref A (a19) x)
            x)))
     '(lambda (x) x))
   (begin

release_notes/release_notes.stex

@@ -124,6 +124,11 @@ iOS compilation target. Native-code support for iOS is currently limited
 to applications attached to a debugger as the platform does not allow
 executable code to be loaded at runtime.
 
+\subsection{Standard boolean foreign type (10.1.0)}
+
+The \scheme{stdbool} foreign type corresponds to \scheme{bool} as
+defined by the host machine's \scheme{stdbool.h} include file.
+
 \subsection{Unicode 15.1 support (10.0.0)}
 
 The character sets, character classes, and word-breaking algorithms for character, string,

s/cmacros.ss

@@ -357,7 +357,7 @@
 ;; ---------------------------------------------------------------------
 ;; Version and machine types:
 
-(define-constant scheme-version #x0a010002)
+(define-constant scheme-version #x0a010003)
 
 (define-syntax define-machine-types
   (lambda (x)
@@ -1209,7 +1209,8 @@
       (fixnum (constant ptr-bytes) fixnum?)
       (char 1 $foreign-char?)
       (wchar (fxsrl (constant wchar-bits) 3) $foreign-wchar?)
-      (boolean (fxsrl (constant int-bits) 3) (lambda (x) #t)))))
+      (boolean (fxsrl (constant int-bits) 3) (lambda (x) #t))
+      (stdbool (fxsrl (constant stdbool-bits) 3) (lambda (x) #t)))))
 )
 
 (define-syntax record-datatype