Skip to content

Commit

Permalink
Chez Scheme: add libffi support for pb
Browse files Browse the repository at this point in the history
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.
  • Loading branch information
mflatt committed Jan 24, 2022
1 parent d41b86c commit 4480e64
Show file tree
Hide file tree
Showing 46 changed files with 1,756 additions and 221 deletions.
2 changes: 1 addition & 1 deletion .makefile
Expand Up @@ -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:
Expand Down
14 changes: 7 additions & 7 deletions Makefile
Expand Up @@ -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 =
Expand Down Expand Up @@ -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)"
Expand Down
2 changes: 1 addition & 1 deletion pkgs/base/info.rkt
Expand Up @@ -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]))
Expand Down
2 changes: 1 addition & 1 deletion racket/src/ChezScheme/c/Mf-base
Expand Up @@ -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}

Expand Down
5 changes: 5 additions & 0 deletions racket/src/ChezScheme/c/alloc.c
Expand Up @@ -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
}
}

Expand Down
12 changes: 7 additions & 5 deletions racket/src/ChezScheme/c/atomic.h
Expand Up @@ -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)
Expand All @@ -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)
Expand Down Expand Up @@ -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
6 changes: 6 additions & 0 deletions racket/src/ChezScheme/c/externs.h
Expand Up @@ -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
Expand Down Expand Up @@ -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();

0 comments on commit 4480e64

Please sign in to comment.