Merge branch 'main' into olopierpa/main

# Conflicts: # release_notes/release_notes.stex
cisco · Jun 17, 2024 · 4ad96be · 4ad96be
2 parents f3eb9fa + 089a481
commit 4ad96be
Show file tree

Hide file tree

Showing 39 changed files with 881 additions and 487 deletions.
diff --git a/BUILDING b/BUILDING
@@ -146,10 +146,19 @@ type of build and the installation location. For example,
 specifies the installation root. Run `./configure --help` for
 information on the supported options.
 
+For platforms without support for native-code compilation in Chez
+Scheme, use a machine specification like `-m=tpb64l`, which is a
+threaded, 64-bit, little-endian build. The "configure" script will
+still attept to infer compilation and linking flags for the kernel; if
+you need to give it a hint, you can use the `--os` flag with something
+like `--os=tXle`, which indicates a threaded configuration (due to the
+leading "t") on Linux (due to the trailing "le").
+
 The generated makefile mostly just ensures that a `zuo` executable is
 built in a `bin` directory, and then it defers the actual build work
 to `zuo`, which uses the "main.zuo" file. If you have `zuo` installed,
-you can use `zuo` directly instead of `make`. In general, instead of
+you can use `zuo` directly instead of `make`: in that case, you may
+wish to use `./configure ZUO=<zuo>`. In general, instead of
 the command `make X` to build target `X` as described below, you can
 use `zuo . X` (or `bin/zuo . X` after `bin/zuo` is built).
 
@@ -333,7 +342,7 @@ The makefile supports several targets:
  * `make clean`
 
    Removes all built elements from the workarea, and then removes
-   `bin/zuo`.
+   `bin/zuo` (unless configured with `ZUO=<zuo>`).
 
 
 WINDOWS VIA COMMAND PROMPT

diff --git a/IMPLEMENTATION.md b/IMPLEMENTATION.md
@@ -1353,6 +1353,15 @@ code for a basic build; on a big-endian machine, the kernel rewrites
 instruction bytes to big-endian form while loading a fasl file, so the
 interpreter can decode instructions in native order.
 
+A basic build supports only a limited, hardwired set of foreign
+interfaces that are sufficient to access kernel functions. A non-basic
+build can support the full foreign interface if the Scheme build is
+configured to use libffi. The pb32 variants assume 8-byte alignment in
+structs for doubles and 64-bit integer values, which can limit
+interoperability with foreign libraries on platforms with a different
+alignment convention (such as non-Windows x86, where doubles and
+64-bit integers need only 4-byte alignment).
+
 For a non-basic build, fragments of static Scheme code can be turned
 into C code to compile and plug back into the kernel. These fragments
 are called *pbchunks*.

diff --git a/README.md b/README.md
@@ -67,7 +67,7 @@ The R6RS core of the Chez Scheme language is described in
 which also includes an introduction to Scheme and a set of example programs.
 Chez Scheme's additional language, run-time system, and
 programming environment features are described in the
-[Chez Scheme User's Guide](http://cisco.github.io/ChezScheme/csug9.5/csug.html).
+[Chez Scheme User's Guide](http://cisco.github.io/ChezScheme/csug10.0/csug.html).
 The latter includes a shared index and a shared summary of forms,
 with links where appropriate to the former, so it is often the best
 starting point.

diff --git a/boot/pb/gc-ocd.inc b/boot/pb/gc-ocd.inc
@@ -131,9 +131,26 @@ static IGEN copy(thread_gc *tgc, ptr p, seginfo *si, ptr *dest)
                   {
                     uptr len = Sbytevector_reference_length(p);
                     memcpy_aligned(&BVIT(new_p, 0), &BVIT(p, 0), ptr_bytes * len);
-                    if ((len & 1) == 0)
                     {
-                      INITBVREFIT(new_p, len) = FIX(0);
+                      uptr extra = (Sbytevector_length(p)) - (len * ptr_bytes);
+                      if (extra == 0)
+                      {
+                        if ((len & 1) == 0)
+                        {
+                          INITBVREFIT(new_p, len) = FIX(0);
+                        }
+                      }
+                      else
+                      {
+                        INITBVREFIT(new_p, len) = INITBVREFIT(p, len);
+                        {
+                          uptr xlen = len + 1;
+                          if ((xlen & 1) == 0)
+                          {
+                            INITBVREFIT(new_p, xlen) = FIX(0);
+                          }
+                        }
+                      }
                     }
                   }
                 }

diff --git a/boot/pb/gc-oce.inc b/boot/pb/gc-oce.inc
@@ -206,9 +206,26 @@ static IGEN copy(thread_gc *tgc, ptr p, seginfo *si, ptr *dest)
                   {
                     uptr len = Sbytevector_reference_length(p);
                     memcpy_aligned(&BVIT(new_p, 0), &BVIT(p, 0), ptr_bytes * len);
-                    if ((len & 1) == 0)
                     {
-                      INITBVREFIT(new_p, len) = FIX(0);
+                      uptr extra = (Sbytevector_length(p)) - (len * ptr_bytes);
+                      if (extra == 0)
+                      {
+                        if ((len & 1) == 0)
+                        {
+                          INITBVREFIT(new_p, len) = FIX(0);
+                        }
+                      }
+                      else
+                      {
+                        INITBVREFIT(new_p, len) = INITBVREFIT(p, len);
+                        {
+                          uptr xlen = len + 1;
+                          if ((xlen & 1) == 0)
+                          {
+                            INITBVREFIT(new_p, xlen) = FIX(0);
+                          }
+                        }
+                      }
                     }
                     S_G.countof[tg][countof_bytevector] += 1;
                     S_G.bytesof[tg][countof_bytevector] += p_sz;

diff --git a/boot/pb/gc-par.inc b/boot/pb/gc-par.inc
@@ -131,9 +131,26 @@ static IGEN copy(thread_gc *tgc, ptr p, seginfo *si, ptr *dest)
                   {
                     uptr len = Sbytevector_reference_length(p);
                     memcpy_aligned(&BVIT(new_p, 0), &BVIT(p, 0), ptr_bytes * len);
-                    if ((len & 1) == 0)
                     {
-                      INITBVREFIT(new_p, len) = FIX(0);
+                      uptr extra = (Sbytevector_length(p)) - (len * ptr_bytes);
+                      if (extra == 0)
+                      {
+                        if ((len & 1) == 0)
+                        {
+                          INITBVREFIT(new_p, len) = FIX(0);
+                        }
+                      }
+                      else
+                      {
+                        INITBVREFIT(new_p, len) = INITBVREFIT(p, len);
+                        {
+                          uptr xlen = len + 1;
+                          if ((xlen & 1) == 0)
+                          {
+                            INITBVREFIT(new_p, xlen) = FIX(0);
+                          }
+                        }
+                      }
                     }
                   }
                 }

diff --git a/build.zuo b/build.zuo
@@ -224,10 +224,15 @@
            token))
 
   (define stexlib
-    (let ((found (assoc "STEXLIB" (hash-ref (runtime-env) 'env))))
-      (if found
-          (cdr found)
-          (at-source "stex"))))
+    (let ([configured (hash-ref config 'STEXLIB "")]
+          [env (assoc "STEXLIB" (hash-ref (runtime-env) 'env))])
+      (cond
+        [(not (equal? "" configured))
+         configured]
+        [env
+         (cdr env)]
+        [else
+         (at-source "stex")])))
   (define stex-sources
     (source-tree stexlib))
 

diff --git a/c/atomic.h b/c/atomic.h
@@ -1,39 +1,61 @@
+/* `STORE_FENCE` is used by the storage-management system, but
+   `ACQUIRE_FENCE`, `RELEASE_FENCE`, and `COMPARE_AND_SWAP_PTR`
+   are used only by the pb interpreter.
+
+   It's always ok to map `ACQUIRE_FENCE` and `RELEASE_FENCE` to
+   `STORE_FENCE`. For portability, we mainly rely on a
+   `__sync_synchronize` intrinsic as provided by reasonably modern
+   versions of GCC and Clang. In some cases, more specialized fence
+   variants are available via inline assembly or platform-specific
+   intrinsics. When inline assembly is written only for `STORE_FENCE`
+   below, then the only advantage over using `__sync_synchronize` is
+   to support environments with different or very old compilers.
+
+   For `COMPARE_AND_SWAP_PTR`, we similarlly rely on a GCC/Clang
+   `__sync_bool_compare_and_swap` intrinsic. Some inline-assembly
+   versions are here --- but, again, the only advantage of those is to
+   support environments with different or very old compilers. */
+
 #if !defined(PTHREADS)
 # define STORE_FENCE() do { } while (0)
 #elif defined(_MSC_VER) && defined(_M_ARM64)
-# define STORE_FENCE() __dmb(_ARM64_BARRIER_ISHST)
+# define STORE_FENCE()   __dmb(_ARM64_BARRIER_ISHST)
 # define ACQUIRE_FENCE() __dmb(_ARM64_BARRIER_ISH)
 # define RELEASE_FENCE() ACQUIRE_FENCE()
 #elif defined(__arm64__) || defined(__aarch64__)
-# define STORE_FENCE() __asm__ __volatile__ ("dmb ishst" : : : "memory")
+# define STORE_FENCE()   __asm__ __volatile__ ("dmb ishst" : : : "memory")
 # define ACQUIRE_FENCE() __asm__ __volatile__ ("dmb ish" : : : "memory")
 # define RELEASE_FENCE() ACQUIRE_FENCE()
 #elif defined(__arm__)
 # if (arm_isa_version >= 7) || (__ARM_ARCH >= 7)
-#  define STORE_FENCE() __asm__ __volatile__ ("dmb ishst" : : : "memory")
+#  define STORE_FENCE()   __asm__ __volatile__ ("dmb ishst" : : : "memory")
 #  define ACQUIRE_FENCE() __asm__ __volatile__ ("dmb ish" : : : "memory")
 #  define RELEASE_FENCE() ACQUIRE_FENCE()
 # else
-#  define STORE_FENCE() __asm__ __volatile__ ("mcr p15, 0, %0, c7, c10, 5" : : "r" (0) : "memory")
+#  define STORE_FENCE()   __asm__ __volatile__ ("mcr p15, 0, %0, c7, c10, 5" : : "r" (0) : "memory")
 #  define ACQUIRE_FENCE() STORE_FENCE()
 #  define RELEASE_FENCE() STORE_FENCE()
 # endif
 #elif defined(__powerpc64__)
-# define STORE_FENCE() __asm__ __volatile__ ("lwsync" : : : "memory")
+# define STORE_FENCE()   __asm__ __volatile__ ("lwsync" : : : "memory")
 # define ACQUIRE_FENCE() __asm__ __volatile__ ("sync" : : : "memory")
 # define RELEASE_FENCE() ACQUIRE_FENCE()
 #elif defined(__powerpc__) || defined(__POWERPC__)
-# define STORE_FENCE() __asm__ __volatile__ ("sync" : : : "memory")
+# define STORE_FENCE()   __asm__ __volatile__ ("sync" : : : "memory")
 # define ACQUIRE_FENCE() STORE_FENCE()
 # define RELEASE_FENCE() STORE_FENCE()
 #elif defined(__riscv)
-# define STORE_FENCE() __asm__ __volatile__ ("fence w,rw" : : : "memory")
+# define STORE_FENCE()   __asm__ __volatile__ ("fence w,rw" : : : "memory")
 # define ACQUIRE_FENCE() __asm__ __volatile__ ("fence r,rw" : : : "memory")
 # define RELEASE_FENCE() __asm__ __volatile__ ("fence rw,r" : : : "memory")
 #elif defined(__loongarch64)
-# define STORE_FENCE() __asm__ __volatile__ ("dbar 0" : : : "memory")
-# define ACQUIRE_FENCE() __asm__ __volatile__ ("dbar 0" : : : "memory")
-# define RELEASE_FENCE() __asm__ __volatile__ ("dbar 0" : : : "memory")
+# define STORE_FENCE()   __asm__ __volatile__ ("dbar 0" : : : "memory")
+# define ACQUIRE_FENCE() STORE_FENCE()
+# define RELEASE_FENCE() STORE_FENCE()
+#elif (__GNUC__ >= 5) || defined(__clang__)
+# define STORE_FENCE() __sync_synchronize()
+# define ACQUIRE_FENCE() STORE_FENCE()
+# define RELEASE_FENCE() STORE_FENCE()
 #else
 # define STORE_FENCE() do { } while (0)
 #endif
@@ -46,40 +68,22 @@
 #endif
 
 #if !defined(PTHREADS)
-# define CAS_ANY_FENCE(a, old, new) ((*(ptr *)(a) == TO_PTR(old)) ? (*(ptr)(a) = TO_PTR(new), 1) : 0)
+# define COMPARE_AND_SWAP_PTR(a, old, new) ((*(ptr *)(a) == TO_PTR(old)) ? (*(ptr)(a) = TO_PTR(new), 1) : 0)
 #elif defined(_MSC_VER)
 # if ptr_bits == 64
-#  define CAS_ANY_FENCE(a, old, new) (_InterlockedCompareExchange64((__int64 *)(a), (__int64)(new), (__int64)(old)) == (__int64)(old))
+#  define COMPARE_AND_SWAP_PTR(a, old, new) (_InterlockedCompareExchange64((__int64 *)(a), (__int64)(new), (__int64)(old)) == (__int64)(old))
 # else
-#  define CAS_ANY_FENCE(a, old, new) (_InterlockedCompareExchange64((long *)(a), (long)(new), (long)(old)) == (long)(old))
+#  define COMPARE_AND_SWAP_PTR(a, old, new) (_InterlockedCompareExchange((long *)(a), (long)(new), (long)(old)) == (long)(old))
 # endif
 #elif defined(__arm64__) || defined(__aarch64__)
-FORCEINLINE int CAS_LOAD_ACQUIRE(volatile void *addr, void *old_val, void *new_val) {
+FORCEINLINE int COMPARE_AND_SWAP_PTR(volatile void *addr, void *old_val, void *new_val) {
   I64 ret;
   __asm__ __volatile__ ("mov %0, #0\n\t"
-                        "0:\n\t"
-                        "ldaxr x12, [%1, #0]\n\t"
-                        "cmp x12, %2\n\t"
-                        "bne 1f\n\t"
-                        "stxr w7, %3, [%1, #0]\n\t"
-                        "cmp x7, #0\n\t"
-                        "bne 1f\n\t"
-                        "mov %0, #1\n\t"
-                        "1:\n\t"
-                        : "=&r" (ret)
-                        : "r" (addr), "r" (old_val), "r" (new_val)
-                        : "cc", "memory", "x12", "x7");
-  return ret;
-}
-/* same as above, but ldaxr -> ldxr and stxr -> stlxr */
-FORCEINLINE int CAS_STORE_RELEASE(volatile void *addr, void *old_val, void *new_val) {
-  I64 ret;
-  __asm__ __volatile__ ("mov %0, #0\n\t"       
                         "0:\n\t"
                         "ldxr x12, [%1, #0]\n\t"
                         "cmp x12, %2\n\t"
                         "bne 1f\n\t"
-                        "stlxr w7, %3, [%1, #0]\n\t"
+                        "stxr w7, %3, [%1, #0]\n\t"
                         "cmp x7, #0\n\t"
                         "bne 1f\n\t"
                         "mov %0, #1\n\t"
@@ -89,13 +93,9 @@ FORCEINLINE int CAS_STORE_RELEASE(volatile void *addr, void *old_val, void *new_
                         : "cc", "memory", "x12", "x7");
   return ret;
 }
-#elif defined(__arm__)
-FORCEINLINE int S_cas_any_fence(int load_acquire, volatile void *addr, void *old_val, void *new_val) {
+#elif defined(__arm__) && ((arm_isa_version >= 6) || (__ARM_ARCH >= 6))
+FORCEINLINE int COMPARE_AND_SWAP_PTR(volatile void *addr, void *old_val, void *new_val) {
   int ret;
-  if (load_acquire)
-    ACQUIRE_FENCE();
-  else
-    RELEASE_FENCE();
   __asm__ __volatile__ ("mov %0, #0\n\t"
                         "0:\n\t"
                         "ldrex r12, [%1]\n\t"
@@ -112,27 +112,24 @@ FORCEINLINE int S_cas_any_fence(int load_acquire, volatile void *addr, void *old
                         : "cc", "memory", "r12", "r7");
   return ret;
 }
-# define CAS_LOAD_ACQUIRE(a, old, new) S_cas_any_fence(1, a, old, new)
-# define CAS_STORE_RELEASE(a, old, new) S_cas_any_fence(0, a, old, new)
 #elif (__GNUC__ >= 5) || defined(__clang__)
-# define CAS_ANY_FENCE(a, old, new) __sync_bool_compare_and_swap((ptr *)(a), TO_PTR(old), TO_PTR(new))
+# define COMPARE_AND_SWAP_PTR(a, old, new) __sync_bool_compare_and_swap((ptr *)(a), TO_PTR(old), TO_PTR(new))
 #elif defined(__i386__) || defined(__x86_64__)
 # if ptr_bits == 64
 #   define CAS_OP_SIZE "q"
 # else
 #   define CAS_OP_SIZE ""
 # endif
-FORCEINLINE int S_cas_any_fence(volatile void *addr, void *old_val, void *new_val) {
+FORCEINLINE int COMPARE_AND_SWAP_PTR(volatile void *addr, void *old_val, void *new_val) {
   char result;
   __asm__ __volatile__("lock; cmpxchg" CAS_OP_SIZE " %3, %0; setz %1"
                        : "=m"(*(void **)addr), "=q"(result)
                        : "m"(*(void **)addr), "r" (new_val), "a"(old_val)
                        : "memory");
   return (int) result;
 }
-# define CAS_ANY_FENCE(a, old, new) S_cas_any_fence(a, old, new)
 #elif defined(__powerpc64__)
-FORCEINLINE int S_cas_any_fence(volatile void *addr, void *old_val, void *new_val) {
+FORCEINLINE int COMPARE_AND_SWAP_PTR(volatile void *addr, void *old_val, void *new_val) {
   int ret, tmp;
   __asm__ __volatile__ ("li %0, 0\n\t"
                         "0:\n\t"
@@ -148,18 +145,10 @@ FORCEINLINE int S_cas_any_fence(volatile void *addr, void *old_val, void *new_va
                         : "cc", "memory");
   return ret;
 }
-# define CAS_ANY_FENCE(a, old, new) S_cas_any_fence(a, old, new)
 #elif defined(__riscv)
-# error expected a compiler with a CS intrinsic for RISC-V
+# error expected a compiler with a CAS intrinsic for RISC-V
 #elif defined(__loongarch64)
-# error TODO
-#else
-# define CAS_ANY_FENCE(a, old, new) ((*(ptr *)(a) == TO_PTR(old)) ? (*(ptr *)(a) = TO_PTR(new), 1) : 0)
-#endif
-
-#ifdef CAS_ANY_FENCE
-# define CAS_LOAD_ACQUIRE(a, old, new)  CAS_ANY_FENCE(a, old, new)
-# define CAS_STORE_RELEASE(a, old, new) CAS_ANY_FENCE(a, old, new)
+# error expected a compiler with a CAS intrinsic for LoongArch64
 #else
-# define CAS_ANY_FENCE(a, old, new) CAS_LOAD_ACQUIRE(a, old, new)  
+# define COMPARE_AND_SWAP_PTR(a, old, new) ((*(ptr *)(a) == TO_PTR(old)) ? (*(ptr *)(a) = TO_PTR(new), 1) : 0)
 #endif
diff --git a/c/build.zuo b/c/build.zuo
@@ -93,7 +93,7 @@
          kernel-srcs))
 
   (define kernel-asm-files
-    (if (glob-match? "*nt" (or (lookup 'defaultm) m))
+    (if (glob-match? "*nt" (or (lookup 'flagsm) m))
 	(cond
           [(and msvc?
                 (string=? arch "a6"))
@@ -504,14 +504,14 @@
                                       " /DSCHEME_STATIC")
                                   " /Ox /W3 /DWIN32 /D_CRT_SECURE_NO_WARNINGS"
                                   " /Zi /FS /Fd" (string->shell (at-dir "scheme.pdb"))
-                                  (if (glob-match? "pb*" (hash-ref config 'm))
+                                  (if (glob-match? "pb*" (m->arch (hash-ref config 'm)))
                                       " /DFEATURE_WINDOWS"
                                       "")))]
             [config (hash-set config 'LDFLAGS (if (as-runtime-dll? config) "/MD" "/MT"))]
             [config (hash-set config 'LIBS "rpcrt4.lib ole32.lib advapi32.lib User32.lib")])
        config)]
-    [(and (eq? 'windows (system-type))
-          (glob-match? "pb*" (hash-ref config 'm)))
+    [(and (glob-match? "*nt" (hash-ref config 'flagsm ""))
+          (glob-match? "pb*" (m->arch (hash-ref config 'm))))
      (config-merge config 'CFLAGS "-DFEATURE_WINDOWS")]
     [else config]))
 
@@ -554,7 +554,7 @@
 (define (for-windows? config)
   (or (is-msvc? config)
       (glob-match? "*nt" (hash-ref config 'm))
-      (glob-match? "*nt" (or (hash-ref config 'defaultm #f) ""))))
+      (glob-match? "*nt" (or (hash-ref config 'flagsm #f) ""))))
 
 (define (lib-build-suffix config)
   (if (is-msvc? config)

diff --git a/c/expeditor.c b/c/expeditor.c
@@ -677,7 +677,7 @@ static void s_ee_set_color(int color_id, IBOOL background) {
 # include <unistd.h>
 # include <time.h>
 #endif
-#if !defined(__GLIBC__) && !defined(__OpenBSD__) && !defined(__NetBSD__) && !defined(__linux__) && !defined(__EMSCRIPTEN__) && !defined(NO_USELOCALE)
+#if !defined(__GLIBC__) && !defined(__COSMOPOLITAN__) && !defined(__OpenBSD__) && !defined(__NetBSD__) && !defined(__linux__) && !defined(__EMSCRIPTEN__) && !defined(NO_USELOCALE)
 # include <xlocale.h>
 #endif