Chez Scheme: larger range for relative return address
A 16-bit range is not large enough for "nanopass/pass.ss".
This commit is contained in:
Matthew Flatt
parent
20be8ffc03
commit
6e0c9c00b9
10
.makefile
10
.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)
|
||||
|
|
|
|||
16
Makefile
16
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)"
|
||||
|
|
|
|||
|
|
@ -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]))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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 )
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
)
|
||||
|
||||
|
|
|
|||
|
|
@ -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)))]))))
|
||||
|
|
|
|||
|
|
@ -113,6 +113,7 @@ case "$Muniarch" in
|
|||
i3qnx) March=i3 ;;
|
||||
i3s2) March=i3 ;;
|
||||
ppc32le) March=ppc32 ;;
|
||||
pb) March=pb ;;
|
||||
*) March="" ;;
|
||||
esac
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user