suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Chez Scheme: repair for reify-cc register saving on arm32

Browse Source 
This repair is simpler approach than the original, and it makes the
manual register allocation a little less fragile.
This commit is contained in:
Matthew Flatt 2021-01-23 10:11:21 -07:00
parent 00ce8904c7
commit 442d7d2d00
8 changed files with 16 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.makefile
View File

@ -338,7 +338,7 @@ RACKET_FOR_BOOTFILES = $(RACKET)
RACKET_FOR_BUILD = $(RACKET) RACKET_FOR_BUILD = $(RACKET)
# This branch name changes each time the pb boot files are updated: # This branch name changes each time the pb boot files are updated:
PB_BRANCH == circa-8.0.0.1-1 PB_BRANCH == circa-8.0.0.3-1
PB_REPO = https://github.com/racket/pb PB_REPO = https://github.com/racket/pb
# Alternative source for Chez Scheme boot files, normally set by # Alternative source for Chez Scheme boot files, normally set by

12
Makefile
View File

@ -47,7 +47,7 @@ RACKETCS_SUFFIX =
RACKET = RACKET =
RACKET_FOR_BOOTFILES = $(RACKET) RACKET_FOR_BOOTFILES = $(RACKET)
RACKET_FOR_BUILD = $(RACKET) RACKET_FOR_BUILD = $(RACKET)
PB_BRANCH = circa-8.0.0.1-1 PB_BRANCH = circa-8.0.0.3-1
PB_REPO = https://github.com/racket/pb PB_REPO = https://github.com/racket/pb
EXTRA_REPOS_BASE = EXTRA_REPOS_BASE =
CS_CROSS_SUFFIX = CS_CROSS_SUFFIX =
@ -307,18 +307,18 @@ maybe-fetch-pb-as-is:
echo done echo done
fetch-pb-from: fetch-pb-from:
mkdir -p racket/src/ChezScheme/boot mkdir -p racket/src/ChezScheme/boot
if [ ! -d racket/src/ChezScheme/boot/pb ] ; then git clone -q -b circa-8.0.0.1-1 $(PB_REPO) racket/src/ChezScheme/boot/pb ; else cd racket/src/ChezScheme/boot/pb && git fetch -q origin circa-8.0.0.1-1:remotes/origin/circa-8.0.0.1-1 ; fi if [ ! -d racket/src/ChezScheme/boot/pb ] ; then git clone -q -b circa-8.0.0.3-1 $(PB_REPO) racket/src/ChezScheme/boot/pb ; else cd racket/src/ChezScheme/boot/pb && git fetch -q origin circa-8.0.0.3-1:remotes/origin/circa-8.0.0.3-1 ; fi
cd racket/src/ChezScheme/boot/pb && git checkout -q circa-8.0.0.1-1 cd racket/src/ChezScheme/boot/pb && git checkout -q circa-8.0.0.3-1
pb-fetch: pb-fetch:
$(MAKE) fetch-pb EXTRA_REPOS_BASE="$(EXTRA_REPOS_BASE)" PB_REPO="$(PB_REPO)" $(MAKE) fetch-pb EXTRA_REPOS_BASE="$(EXTRA_REPOS_BASE)" PB_REPO="$(PB_REPO)"
pb-build: pb-build:
cd racket/src/ChezScheme && racket rktboot/main.rkt --machine pb cd racket/src/ChezScheme && racket rktboot/main.rkt --machine pb
pb-stage: pb-stage:
cd racket/src/ChezScheme/boot/pb && git branch circa-8.0.0.1-1 cd racket/src/ChezScheme/boot/pb && git branch circa-8.0.0.3-1
cd racket/src/ChezScheme/boot/pb && git checkout circa-8.0.0.1-1 cd racket/src/ChezScheme/boot/pb && git checkout circa-8.0.0.3-1
cd racket/src/ChezScheme/boot/pb && git add . && git commit --amend -m "new build" cd racket/src/ChezScheme/boot/pb && git add . && git commit --amend -m "new build"
pb-push: pb-push:
cd racket/src/ChezScheme/boot/pb && git push -u origin circa-8.0.0.1-1 cd racket/src/ChezScheme/boot/pb && git push -u origin circa-8.0.0.3-1
win-cs-base: 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 "$(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)" 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)"

2
pkgs/base/info.rkt
View File

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

2
racket/src/ChezScheme/makefiles/Mf-install.in
View File

@ -62,7 +62,7 @@ InstallLZ4Target=
# no changes should be needed below this point # # no changes should be needed below this point #
############################################################################### ###############################################################################
Version=csv9.5.5.1 Version=csv9.5.5.2
Include=boot/$m Include=boot/$m
PetiteBoot=boot/$m/petite.boot PetiteBoot=boot/$m/petite.boot
SchemeBoot=boot/$m/scheme.boot SchemeBoot=boot/$m/scheme.boot

2
racket/src/ChezScheme/s/arm32.ss
View File

@ -76,7 +76,7 @@
#;[%ac1] #;[%ac1]
#;[%yp] #;[%yp]
[ %r0 %Carg1 %Cretval #f 0 uptr] [ %r0 %Carg1 %Cretval #f 0 uptr]
[ %r1 %Carg2 %save1 #f 1 uptr] [ %r1 %Carg2 #f 1 uptr]
[ %r2 %Carg3 %reify1 #f 2 uptr] [ %r2 %Carg3 %reify1 #f 2 uptr]
[ %r3 %Carg4 %reify2 #f 3 uptr] [ %r3 %Carg4 %reify2 #f 3 uptr]
[ %lr #f 14 uptr] ; %lr is trashed by 'c' calls including calls to hand-coded routines like get-room [ %lr #f 14 uptr] ; %lr is trashed by 'c' calls including calls to hand-coded routines like get-room

3
racket/src/ChezScheme/s/cmacros.ss
View File

@ -357,7 +357,7 @@
;; --------------------------------------------------------------------- ;; ---------------------------------------------------------------------
;; Version and machine types: ;; Version and machine types:
(define-constant scheme-version #x09050501) (define-constant scheme-version #x09050502)
(define-syntax define-machine-types (define-syntax define-machine-types
(lambda (x) (lambda (x)
@ -1545,6 +1545,7 @@
[xptr ts] [xptr ts]
[xptr td] [xptr td]
[xptr real_eap] [xptr real_eap]
[xptr save1]
[ptr virtual-registers (constant virtual-register-count)] [ptr virtual-registers (constant virtual-register-count)]
[ptr guardian-entries] [ptr guardian-entries]
[ptr cchain] [ptr cchain]

19
racket/src/ChezScheme/s/cpnanopass.ss
View File

@ -496,6 +496,7 @@
[(%trap) (constant tc-trap-disp)] [(%trap) (constant tc-trap-disp)]
[(%xp) (constant tc-xp-disp)] [(%xp) (constant tc-xp-disp)]
[(%yp) (constant tc-yp-disp)] [(%yp) (constant tc-yp-disp)]
[(%save1) (constant tc-save1-disp)]
[else #f])]))) [else #f])])))
(define-syntax define-reserved-registers (define-syntax define-reserved-registers
@ -3517,20 +3518,6 @@
#'reg #'reg
(with-implicit (k %mref) #`(%mref ,%tc ,(tc-disp reg))))]))) (with-implicit (k %mref) #`(%mref ,%tc ,(tc-disp reg))))])))
(define-syntax ref-reg-list
(lambda (x)
(syntax-case x ()
[(k ?reg ...)
(fold-right
(lambda (reg ref*)
(cond
[(real-register? (syntax->datum reg))
#`(cons #,reg #,ref*)]
[(memq (syntax->datum reg) '(%ac0 %ac1 %sfp %cp %esp %ap %eap %trap %xp %yp))
(with-implicit (k ref-reg) #`(cons (ref-reg #,reg) #,ref*))]
[else ref*]))
#''() #'(?reg ...))])))
;; After the `np-expand-primitives` pass, some expression produce ;; After the `np-expand-primitives` pass, some expression produce
;; double (i.e., floating-point) values instead of pointer values. ;; double (i.e., floating-point) values instead of pointer values.
;; Those expression results always flow to an `inline` primitive ;; Those expression results always flow to an `inline` primitive
@ -12479,13 +12466,13 @@
[ref-tmpreg* (with-output-language (L13 Lvalue) [ref-tmpreg* (with-output-language (L13 Lvalue)
;; Does not have to be in the same order as `tmp-reg*`, ;; Does not have to be in the same order as `tmp-reg*`,
;; but everything here must be in `tmp-reg*` ;; but everything here must be in `tmp-reg*`
(ref-reg-list %ac1 %yp %save1))] (list (ref-reg %ac1) (ref-reg %yp) (ref-reg %save1)))]
[save-reg* (fold-left (lambda (reg* r) [save-reg* (fold-left (lambda (reg* r)
(cond (cond
[(memq r reg*) reg*] [(memq r reg*) reg*]
[(memq r reify-cc-modify-reg*) (cons r reg*)] [(memq r reify-cc-modify-reg*) (cons r reg*)]
[(memq r tmp-reg*) [(memq r tmp-reg*)
($oops who "reify-cc-save live register conflicts ~s" reg*)] ($oops who "reify-cc-save live register conflicts ~s ~s" r tmp-reg*)]
[else reg*])) [else reg*]))
'() live-reg*)]) '() live-reg*)])
(define (ref-tmp-reg i) (define (ref-tmp-reg i)

2
racket/src/version/racket_version.h
View File

@ -16,7 +16,7 @@
#define MZSCHEME_VERSION_X 8 #define MZSCHEME_VERSION_X 8
#define MZSCHEME_VERSION_Y 0 #define MZSCHEME_VERSION_Y 0
#define MZSCHEME_VERSION_Z 0 #define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 2 #define MZSCHEME_VERSION_W 3
/* A level of indirection makes `#` work as needed: */ /* A level of indirection makes `#` work as needed: */
#define AS_a_STR_HELPER(x) #x #define AS_a_STR_HELPER(x) #x