From 6e0c9c00b921cf99e80e943ef154cf792f11db4c Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 29 Nov 2020 21:14:27 -0700 Subject: [PATCH] Chez Scheme: larger range for relative return address A 16-bit range is not large enough for "nanopass/pass.ss". --- .makefile | 10 ++- Makefile | 16 +++-- pkgs/base/info.rkt | 2 +- racket/src/ChezScheme/c/fasl.c | 61 ++++++++++++++++--- racket/src/ChezScheme/c/pb.c | 5 +- racket/src/ChezScheme/makefiles/Mf-boot.in | 2 +- racket/src/ChezScheme/makefiles/Mf-install.in | 2 +- racket/src/ChezScheme/s/cmacros.ss | 4 +- racket/src/ChezScheme/s/pb.ss | 9 ++- racket/src/ChezScheme/workarea | 1 + racket/src/cs/compile-file.ss | 2 +- racket/src/version/racket_version.h | 2 +- 12 files changed, 88 insertions(+), 28 deletions(-) diff --git a/.makefile b/.makefile index 2746bba1ae..2c849b171a 100644 --- a/.makefile +++ b/.makefile @@ -338,7 +338,7 @@ RACKET_FOR_BOOTFILES = $(RACKET) RACKET_FOR_BUILD = $(RACKET) # This branch name changes each time the pb boot files are updated: -PB_BRANCH == circa-7.9.0.9-1 +PB_BRANCH == circa-7.9.0.10-1 PB_REPO = https://github.com/racket/pb # Alternative source for Chez Scheme boot files, normally set by @@ -420,7 +420,6 @@ cs-minimal-in-place-after-base: cs-minimal-in-place-after-base-cross: $(MAKE) plain-minimal-in-place-after-base PLAIN_RACKET="$(RACKET_FOR_BUILD)" PLT_SETUP_OPTIONS="--no-pkg-deps $(PLT_SETUP_OPTIONS)" - fetch-pb: if [ "$(EXTRA_REPOS_BASE)" = "" ] ; \ then $(MAKE) fetch-pb-from ; \ @@ -442,12 +441,19 @@ fetch-pb-from: else cd $(PB_DIR) && git fetch -q origin $(PB_BRANCH):remotes/origin/$(PB_BRANCH) ; fi cd $(PB_DIR) && git checkout -q $(PB_BRANCH) +pb-fetch: + $(MAKE) fetch-pb + # Helpers for managing the "pb" repo: +# * `make pb-build` to rebuild pb boot files # * `make pb-stage` after updating `PB_BRANCH` # * `make pb-push` to upload the branch after checking that # the staged branch looks right # If you don't have push access to `PB_REPO`, you may need to # change the origin of your "pb" checkout. +pb-build: + cd racket/src/ChezScheme && racket rktboot/main.rkt --machine pb + pb-stage: cd $(PB_DIR) && git branch $(PB_BRANCH) cd $(PB_DIR) && git checkout $(PB_BRANCH) diff --git a/Makefile b/Makefile index b110f6e184..dbd18958fa 100644 --- a/Makefile +++ b/Makefile @@ -47,7 +47,7 @@ RACKETCS_SUFFIX = RACKET = RACKET_FOR_BOOTFILES = $(RACKET) RACKET_FOR_BUILD = $(RACKET) -PB_BRANCH = circa-7.9.0.9-1 +PB_BRANCH = circa-7.9.0.10-1 PB_REPO = https://github.com/racket/pb EXTRA_REPOS_BASE = CS_CROSS_SUFFIX = @@ -307,14 +307,18 @@ 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 -b circa-7.9.0.9-1 $(PB_REPO) racket/src/ChezScheme/boot/pb ; else cd racket/src/ChezScheme/boot/pb && git fetch -q origin circa-7.9.0.9-1:remotes/origin/circa-7.9.0.9-1 ; fi - cd racket/src/ChezScheme/boot/pb && git checkout -q circa-7.9.0.9-1 + if [ ! -d racket/src/ChezScheme/boot/pb ] ; then git clone -q -b circa-7.9.0.10-1 $(PB_REPO) racket/src/ChezScheme/boot/pb ; else cd racket/src/ChezScheme/boot/pb && git fetch -q origin circa-7.9.0.10-1:remotes/origin/circa-7.9.0.10-1 ; fi + cd racket/src/ChezScheme/boot/pb && git checkout -q circa-7.9.0.10-1 +pb-fetch: + $(MAKE) fetch-pb EXTRA_REPOS_BASE="$(EXTRA_REPOS_BASE)" PB_REPO="$(PB_REPO)" +pb-build: + cd racket/src/ChezScheme && racket rktboot/main.rkt --machine pb pb-stage: - cd racket/src/ChezScheme/boot/pb && git branch circa-7.9.0.9-1 - cd racket/src/ChezScheme/boot/pb && git checkout circa-7.9.0.9-1 + cd racket/src/ChezScheme/boot/pb && git branch circa-7.9.0.10-1 + cd racket/src/ChezScheme/boot/pb && git checkout circa-7.9.0.10-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-7.9.0.9-1 + cd racket/src/ChezScheme/boot/pb && git push -u origin circa-7.9.0.10-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)" diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index 933f8bb01f..0ddc04ab29 100644 --- a/pkgs/base/info.rkt +++ b/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 "7.9.0.9") +(define version "7.9.0.10") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/racket/src/ChezScheme/c/fasl.c b/racket/src/ChezScheme/c/fasl.c index 4308545e38..0bd2d16dbf 100644 --- a/racket/src/ChezScheme/c/fasl.c +++ b/racket/src/ChezScheme/c/fasl.c @@ -1925,14 +1925,21 @@ static void sparc64_set_literal(address, item) void *address; uptr item; { #endif /* SPARC64 */ #ifdef PORTABLE_BYTECODE_BIGENDIAN +typedef struct { + octet *code; + uptr size; +} rpheader_t; +static rpheader_t *rpheader_stack; +static int rpheader_stack_size = 0, rpheader_stack_pos = 0; + static void swap_code_endian(octet *code, uptr len) { - octet *next_rpheader = NULL; - uptr header_size = 0; - while (len > 0) { - if (code == next_rpheader) { + if ((rpheader_stack_pos > 0) + && (code == rpheader_stack[rpheader_stack_pos-1].code)) { /* swap 8-byte segments while we're in the header */ + uptr header_size = rpheader_stack[--rpheader_stack_pos].size; + while (header_size > 0) { octet a = code[0]; octet b = code[1]; @@ -1966,28 +1973,62 @@ static void swap_code_endian(octet *code, uptr len) code[2] = b; code[3] = a; + code += 4; + len -= 4; + if (a == pb_adr) { /* delta can be negative for a mvlet-error reinstall of the return address */ - iptr delta = (int16_t)(uint16_t)(((uptr)d << 8) + c); + iptr delta = (((iptr)d << (ptr_bits - 8)) >> (ptr_bits - 20)) + ((iptr)c << 4) + (b >> 4); if (delta > 0) { /* after a few more instructions, we'll hit a header where 64-bit values needs to be swapped, instead of 32-bit values */ - octet *after_rpheader = code + 4 + delta; + octet *after_rpheader = code + delta, *rpheader; + uptr header_size; + int pos; + + if ((uptr)delta > len) + S_error_abort("swap endian: delta goes past end"); + if (delta & 0x3) + S_error_abort("swap endian: delta is not a multiple of 4"); if (after_rpheader[-8] & 0x1) header_size = size_rp_compact_header; else header_size = size_rp_header; + rpheader = after_rpheader - header_size; - next_rpheader = after_rpheader - header_size; + if (rpheader_stack_pos == rpheader_stack_size) { + int new_size = (2 * rpheader_stack_size) + 16; + rpheader_t *new_stack; + new_stack = malloc(new_size * sizeof(rpheader_t)); + if (rpheader_stack != NULL) { + memcpy(new_stack, rpheader_stack, rpheader_stack_pos * sizeof(rpheader_t)); + free(rpheader_stack); + } + rpheader_stack_size = new_size; + rpheader_stack = new_stack; + } + + rpheader_stack[rpheader_stack_pos].code = rpheader; + rpheader_stack[rpheader_stack_pos].size = header_size; + rpheader_stack_pos++; + + /* bubble down to keep sorted */ + for (pos = rpheader_stack_pos - 2; pos > 0; --pos) { + if (rpheader_stack[pos].code < rpheader_stack[pos+1].code) { + rpheader_t tmp = rpheader_stack[pos]; + rpheader_stack[pos] = rpheader_stack[pos+1]; + rpheader_stack[pos+1] = tmp; + } + } } } - - code += 4; - len -= 4; } } + + if (rpheader_stack_pos > 0) + S_error_abort("swap endian: header stack ends non-empty"); } void S_swap_dounderflow_header_endian(ptr co) diff --git a/racket/src/ChezScheme/c/pb.c b/racket/src/ChezScheme/c/pb.c index a865f5ab62..f023c65424 100644 --- a/racket/src/ChezScheme/c/pb.c +++ b/racket/src/ChezScheme/c/pb.c @@ -17,6 +17,9 @@ typedef uint32_t instruction_t; #define INSTR_di_imm(instr) (((int32_t)(instr)) >> 16) #define INSTR_di_imm_unsigned(instr) ((instr) >> 16) +#define INSTR_adr_dest(instr) INSTR_di_dest(instr) +#define INSTR_adr_imm(instr) (((int32_t)(instr)) >> 12) + #define INSTR_drr_dest(instr) INSTR_d_dest(instr) #define INSTR_drr_reg1(instr) (((instr) >> 12) & 0xF) #define INSTR_drr_reg2(instr) (((instr) >> 16) & 0xF) @@ -673,7 +676,7 @@ void S_pb_interp(ptr tc, void *bytecode) { case pb_return: return; /* <--- not break */ case pb_adr: - regs[INSTR_di_dest(instr)] = (uptr)TO_PTR(next_ip) + INSTR_di_imm(instr); + regs[INSTR_adr_dest(instr)] = (uptr)TO_PTR(next_ip) + INSTR_adr_imm(instr); break; case pb_interp: { diff --git a/racket/src/ChezScheme/makefiles/Mf-boot.in b/racket/src/ChezScheme/makefiles/Mf-boot.in index a79688b8c5..bb97e5c9fd 100644 --- a/racket/src/ChezScheme/makefiles/Mf-boot.in +++ b/racket/src/ChezScheme/makefiles/Mf-boot.in @@ -21,7 +21,7 @@ doit: $(bootfiles) %.boot: rm -rf ../xc-$* - ( cd .. ; "${srcdir}"/workarea $* xc-$* ) + ( cd .. ; "${srcdir}"/workarea $* xc-$* $(m) ) ( cd ../xc-$*/s ; $(MAKE) -f Mf-cross base=../../$(workarea) m=$(m) xm=$* ) mkdir -p ../boot/$* ( cd ../xc-$*/s ; $(MAKE) keepbootfiles ) diff --git a/racket/src/ChezScheme/makefiles/Mf-install.in b/racket/src/ChezScheme/makefiles/Mf-install.in index a8c17621a7..6e5959ca03 100644 --- a/racket/src/ChezScheme/makefiles/Mf-install.in +++ b/racket/src/ChezScheme/makefiles/Mf-install.in @@ -62,7 +62,7 @@ InstallLZ4Target= # no changes should be needed below this point # ############################################################################### -Version=csv9.5.3.52 +Version=csv9.5.3.53 Include=boot/$m PetiteBoot=boot/$m/petite.boot SchemeBoot=boot/$m/scheme.boot diff --git a/racket/src/ChezScheme/s/cmacros.ss b/racket/src/ChezScheme/s/cmacros.ss index 073874ac3f..b29fe30585 100644 --- a/racket/src/ChezScheme/s/cmacros.ss +++ b/racket/src/ChezScheme/s/cmacros.ss @@ -357,7 +357,7 @@ ;; --------------------------------------------------------------------- ;; Version and machine types: -(define-constant scheme-version #x09050334) +(define-constant scheme-version #x09050335) (define-syntax define-machine-types (lambda (x) @@ -375,6 +375,7 @@ (define-machine-types any + pb i3le ti3le i3nt ti3nt i3fb ti3fb @@ -393,7 +394,6 @@ arm32le tarm32le ppc32le tppc32le arm64le tarm64le - pb arm64osx tarm64osx ) diff --git a/racket/src/ChezScheme/s/pb.ss b/racket/src/ChezScheme/s/pb.ss index 4ad46bcc5b..19c8a9a3a4 100644 --- a/racket/src/ChezScheme/s/pb.ss +++ b/racket/src/ChezScheme/s/pb.ss @@ -37,6 +37,9 @@ ;; | op | reg reg | immed/reg | ;; ----------------------------------------------- ;; ----------------------------------------------- +;; | op | reg | immed | +;; ----------------------------------------------- +;; ----------------------------------------------- ;; | op | immed | ;; ----------------------------------------------- ;; @@ -942,8 +945,8 @@ (lambda (op dest offset code*) (emit-code (op dest offset code*) (constant pb-adr) - (ax-ea-reg-code dest) - offset))) + (bitwise-ior (ax-ea-reg-code dest) + (bitwise-arithmetic-shift offset 4))))) (define inc-op (lambda (op dest src code*) @@ -1396,6 +1399,8 @@ (lambda (offset) (let ([incr-offset (adjust-return-point-offset incr-offset l)]) (let ([disp (fx- next-addr (fx- offset incr-offset))]) + (unless (<= (- (expt 2 19)) disp (sub1 (expt 2 19))) + (sorry! who "displacement to large for adr ~s" disp)) (emit adr `(reg . ,dest) disp '()))))] [else (asm-move '() dest (with-output-language (L16 Triv) `(label-ref ,l ,incr-offset)))])))) diff --git a/racket/src/ChezScheme/workarea b/racket/src/ChezScheme/workarea index 9287c67e86..86c5c3e9c1 100755 --- a/racket/src/ChezScheme/workarea +++ b/racket/src/ChezScheme/workarea @@ -113,6 +113,7 @@ case "$Muniarch" in i3qnx) March=i3 ;; i3s2) March=i3 ;; ppc32le) March=ppc32 ;; + pb) March=pb ;; *) March="" ;; esac diff --git a/racket/src/cs/compile-file.ss b/racket/src/cs/compile-file.ss index a9bd8930f0..3315e34f09 100644 --- a/racket/src/cs/compile-file.ss +++ b/racket/src/cs/compile-file.ss @@ -2,7 +2,7 @@ ;; Check to make we're using a build of Chez Scheme ;; that has all the features we need. (define-values (need-maj need-min need-sub need-dev) - (values 9 5 3 52)) + (values 9 5 3 53)) (unless (guard (x [else #f]) (eval 'scheme-fork-version-number)) (error 'compile-file diff --git a/racket/src/version/racket_version.h b/racket/src/version/racket_version.h index e2cd6fff0c..decac23b5e 100644 --- a/racket/src/version/racket_version.h +++ b/racket/src/version/racket_version.h @@ -16,7 +16,7 @@ #define MZSCHEME_VERSION_X 7 #define MZSCHEME_VERSION_Y 9 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 9 +#define MZSCHEME_VERSION_W 10 /* A level of indirection makes `#` work as needed: */ #define AS_a_STR_HELPER(x) #x