Chez Scheme: add libffi support for pb

By using libffi, we can fill in the one piece of Chez Scheme that was
previously unimplemented for pb (portable bytecode) mode: calling
foreign functions and converting a closure to a foreign function.

In principle, this change allows Racket CS to run on any platform
where Racket BC runs (in interpreted mode); the performance of
interpreted Racket code is about the same in those two. But since
Racket BC's compiler is in C and its expander can be compiled to C
(via cify), BC is still much faster to expand and compile programs. A
next step might be to set up a similar compiltion via C for the static
part of Chez Scheme and Racket.

Author: mflatt

.makefile

@@ -344,7 +344,7 @@ RACKET_FOR_BOOTFILES = $(RACKET)
 RACKET_FOR_BUILD = $(RACKET)
 
 # This branch name changes each time the pb boot files are updated:
-PB_BRANCH == circa-8.4.0.2-1
+PB_BRANCH == circa-8.4.0.4-1
 PB_REPO = https://github.com/racket/pb
 
 # Set to empty for Git before v1.7.10:

Makefile

@@ -47,7 +47,7 @@ RACKETCS_SUFFIX =
 RACKET =
 RACKET_FOR_BOOTFILES = $(RACKET)
 RACKET_FOR_BUILD = $(RACKET)
-PB_BRANCH = circa-8.4.0.2-1
+PB_BRANCH = circa-8.4.0.4-1
 PB_REPO = https://github.com/racket/pb
 SINGLE_BRANCH_FLAG = --single-branch
 EXTRA_REPOS_BASE =
@@ -310,19 +310,19 @@ maybe-fetch-pb-as-is:
 	echo done
 fetch-pb-from:
 	mkdir -p racket/src/ChezScheme/boot
-	if [ ! -d racket/src/ChezScheme/boot/pb ] ; 	  then git clone -q $(SINGLE_BRANCH_FLAG) -b circa-8.4.0.2-1 $(PB_REPO) racket/src/ChezScheme/boot/pb ; 	  else cd racket/src/ChezScheme/boot/pb && git fetch -q origin circa-8.4.0.2-1:remotes/origin/circa-8.4.0.2-1 ; fi
-	cd racket/src/ChezScheme/boot/pb && git remote set-branches origin circa-8.4.0.2-1
-	cd racket/src/ChezScheme/boot/pb && git checkout -q circa-8.4.0.2-1
+	if [ ! -d racket/src/ChezScheme/boot/pb ] ; 	  then git clone -q $(SINGLE_BRANCH_FLAG) -b circa-8.4.0.4-1 $(PB_REPO) racket/src/ChezScheme/boot/pb ; 	  else cd racket/src/ChezScheme/boot/pb && git fetch -q origin circa-8.4.0.4-1:remotes/origin/circa-8.4.0.4-1 ; fi
+	cd racket/src/ChezScheme/boot/pb && git remote set-branches origin circa-8.4.0.4-1
+	cd racket/src/ChezScheme/boot/pb && git checkout -q circa-8.4.0.4-1
 pb-fetch:
 	$(MAKE) fetch-pb EXTRA_REPOS_BASE="$(EXTRA_REPOS_BASE)" PB_REPO="$(PB_REPO)" SINGLE_BRANCH_FLAG="$(SINGLE_BRANCH_FLAG)"
 pb-build:
 	cd racket/src/ChezScheme && racket rktboot/main.rkt --machine pb
 pb-stage:
-	cd racket/src/ChezScheme/boot/pb && git branch circa-8.4.0.2-1
-	cd racket/src/ChezScheme/boot/pb && git checkout circa-8.4.0.2-1
+	cd racket/src/ChezScheme/boot/pb && git branch circa-8.4.0.4-1
+	cd racket/src/ChezScheme/boot/pb && git checkout circa-8.4.0.4-1
 	cd racket/src/ChezScheme/boot/pb && git add . && git commit --amend -m "new build"
 pb-push:
-	cd racket/src/ChezScheme/boot/pb && git push -u origin circa-8.4.0.2-1
+	cd racket/src/ChezScheme/boot/pb && git push -u origin circa-8.4.0.4-1
 win-cs-base:
 	IF "$(RACKET_FOR_BUILD)" == "" $(MAKE) win-bc-then-cs-base SETUP_BOOT_MODE=--boot WIN32_BUILD_LEVEL=bc PLAIN_RACKET=racket\racketbc DISABLE_STATIC_LIBS="$(DISABLE_STATIC_LIBS)" EXTRA_REPOS_BASE="$(EXTRA_REPOS_BASE)" JOB_OPTIONS="$(JOB_OPTIONS)" PLT_SETUP_OPTIONS="$(PLT_SETUP_OPTIONS)" RACKETBC_SUFFIX="$(RACKETBC_SUFFIX)" RACKETCS_SUFFIX="$(RACKETCS_SUFFIX)"
 	IF not "$(RACKET_FOR_BUILD)" == "" $(MAKE) win-just-cs-base SETUP_BOOT_MODE=--chain DISABLE_STATIC_LIBS="$(DISABLE_STATIC_LIBS)" EXTRA_REPOS_BASE="$(EXTRA_REPOS_BASE)" JOB_OPTIONS="$(JOB_OPTIONS)" PLT_SETUP_OPTIONS="$(PLT_SETUP_OPTIONS)" RACKETCS_SUFFIX="$(RACKETCS_SUFFIX)" RACKET_FOR_BUILD="$(RACKET_FOR_BUILD)"

pkgs/base/info.rkt

@@ -14,7 +14,7 @@
 
 ;; In the Racket source repo, this version should change only when
 ;; "racket_version.h" changes:
-(define version "8.4.0.3")
+(define version "8.4.0.4")
 
 (define deps `("racket-lib"
                ["racket" #:version ,version]))

racket/src/ChezScheme/c/Mf-base

@@ -40,7 +40,7 @@ KernelLibLinkLibs=${zlibLib} ${LZ4Lib}
 
 kernelsrc=statics.c segment.c alloc.c symbol.c intern.c gcwrapper.c gc-011.c gc-par.c gc-ocd.c gc-oce.c\
  number.c schsig.c io.c new-io.c print.c fasl.c vfasl.c stats.c foreign.c prim.c prim5.c flushcache.c\
- schlib.c thread.c expeditor.c scheme.c compress-io.c random.c
+ schlib.c thread.c expeditor.c scheme.c compress-io.c random.c ffi.c
 
 kernelobj=${kernelsrc:%.c=%.$o} ${mdobj}
 

racket/src/ChezScheme/c/alloc.c

@@ -87,6 +87,11 @@ void S_alloc_init() {
 
         S_protect(&S_G.zero_length_bignum);
         S_G.zero_length_bignum = S_bignum(tc, 0, 0);
+
+#ifdef PORTABLE_BYTECODE
+        S_protect(&S_G.foreign_callables);
+        S_G.foreign_callables = Snil;
+#endif
     }
 }
 

racket/src/ChezScheme/c/atomic.h

@@ -38,15 +38,15 @@
 #elif defined(__arm64__) || defined(__aarch64__)
 FORCEINLINE int CAS_LOAD_ACQUIRE(volatile void *addr, void *old_val, void *new_val) {
   long ret;
-  __asm__ __volatile__ ("mov %0, #0\n\t"       
+  __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 x7, %3, [%1, #0]\n\t"
+                        "stxr w7, %3, [%1, #0]\n\t"
                         "cmp x7, #0\n\t"
                         "bne 1f\n\t"
-                        "moveq %0, #1\n\t"
+                        "mov %0, #1\n\t"
                         "1:\n\t"
                         : "=&r" (ret)
                         : "r" (addr), "r" (old_val), "r" (new_val)
@@ -61,10 +61,10 @@ FORCEINLINE int CAS_STORE_RELEASE(volatile void *addr, void *old_val, void *new_
                         "ldxr x12, [%1, #0]\n\t"
                         "cmp x12, %2\n\t"
                         "bne 1f\n\t"
-                        "stlxr x7, %3, [%1, #0]\n\t"
+                        "stlxr w7, %3, [%1, #0]\n\t"
                         "cmp x7, #0\n\t"
                         "bne 1f\n\t"
-                        "moveq %0, #1\n\t"
+                        "mov %0, #1\n\t"
                         "1:\n\t"
                         : "=&r" (ret)
                         : "r" (addr), "r" (old_val), "r" (new_val)
@@ -126,4 +126,6 @@ FORCEINLINE int S_cas_any_fence(volatile void *addr, void *old_val, void *new_va
 #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)
+#else
+# define CAS_ANY_FENCE(a, old, new) CAS_LOAD_ACQUIRE(a, old, new)  
 #endif

racket/src/ChezScheme/c/externs.h

@@ -438,6 +438,7 @@ void S_longjmp(void *b, int v);
 #ifdef PORTABLE_BYTECODE
 /* pb.c */
 extern void S_pb_interp(ptr tc, void *bytecode);
+extern ptr *S_get_call_arena(ptr tc);
 #endif
 
 #ifdef WIN32
@@ -471,6 +472,11 @@ double S_random_state_next_double PROTO((ptr s));
 void S_random_state_init PROTO((ptr s, UINT x));
 IBOOL S_random_state_check PROTO((double x10, double x11, double x12,
                                   double x20, double x21, double x22));
+/* ffi.c */
+#ifdef PORTABLE_BYTECODE
+extern void S_ffi_call(ptr types, ptr proc, ptr *stack);
+extern ptr S_ffi_closure(ptr types, ptr proc);
+#endif
 
 /* statics.c */
 extern void scheme_statics();