From 6b0b3e0a1e80e22472ee33511e01684fbf9951d7 Mon Sep 17 00:00:00 2001 From: Bogdan Popa Date: Mon, 18 Jan 2021 16:53:54 +0200 Subject: [PATCH] ios: constrain recent allocation segments generation, fix for tarm64->tarm64 cross-compilation Includes new `force-host-out?' arg to `compile-to-file'. When the host and target machines match during "cross"-compilation (eg. M1 Mac to iOS), we still need to generate host .so files so that the build works out. --- racket/src/ChezScheme/c/alloc.c | 3 --- racket/src/ChezScheme/c/segment.c | 10 ++++++---- racket/src/ChezScheme/c/thread.c | 1 + racket/src/ChezScheme/mats/primvars.ms | 1 + racket/src/ChezScheme/s/compile.ss | 9 ++++++--- racket/src/ChezScheme/s/primdata.ss | 2 +- racket/src/cs/compile-file.ss | 3 ++- 7 files changed, 17 insertions(+), 12 deletions(-) diff --git a/racket/src/ChezScheme/c/alloc.c b/racket/src/ChezScheme/c/alloc.c index 2fa3f23212..74ee47a0b0 100644 --- a/racket/src/ChezScheme/c/alloc.c +++ b/racket/src/ChezScheme/c/alloc.c @@ -284,9 +284,6 @@ void S_close_off_thread_local_segment(ptr tc, ISPC s, IGEN g) { close_off_segment(tgc, tgc->next_loc[g][s], tgc->base_loc[g][s], tgc->sweep_loc[g][s], s, g); tgc->base_loc[g][s] = (ptr)0; -#if defined(WRITE_XOR_EXECUTE_CODE) - tgc->base_loc[g][s] = 0; -#endif tgc->bytes_left[g][s] = 0; tgc->next_loc[g][s] = (ptr)0; tgc->sweep_loc[g][s] = (ptr)0; diff --git a/racket/src/ChezScheme/c/segment.c b/racket/src/ChezScheme/c/segment.c index 1a13e03f53..03d75241b6 100644 --- a/racket/src/ChezScheme/c/segment.c +++ b/racket/src/ChezScheme/c/segment.c @@ -659,10 +659,12 @@ static void enable_code_write(ptr tc, IGEN maxg, IBOOL on, IBOOL current, void * if (!on) { while ((sip = tgc->sweep_next[0][space_code]) != NULL) { tgc->sweep_next[0][space_code] = sip->sweep_next; - addr = sip->sweep_start; - bytes = sip->sweep_bytes; - if (mprotect(addr, bytes, flags) != 0) { - S_error_abort("failed to protect recent allocation segments"); + if (sip->generation == 0) { + addr = sip->sweep_start; + bytes = sip->sweep_bytes; + if (mprotect(addr, bytes, flags) != 0) { + S_error_abort("failed to protect recent allocation segments"); + } } } } diff --git a/racket/src/ChezScheme/c/thread.c b/racket/src/ChezScheme/c/thread.c index ec31e3c9a0..39c0c8d7bb 100644 --- a/racket/src/ChezScheme/c/thread.c +++ b/racket/src/ChezScheme/c/thread.c @@ -93,6 +93,7 @@ ptr S_create_thread_object(who, p_tc) const char *who; ptr p_tc; { tgc->next_loc[g][s] = (ptr)0; tgc->bytes_left[g][s] = 0; tgc->sweep_loc[g][s] = (ptr)0; + tgc->sweep_next[g][s] = NULL; } tgc->bitmask_overhead[g] = 0; } diff --git a/racket/src/ChezScheme/mats/primvars.ms b/racket/src/ChezScheme/mats/primvars.ms index f51d6ef35d..71e5fa3882 100644 --- a/racket/src/ChezScheme/mats/primvars.ms +++ b/racket/src/ChezScheme/mats/primvars.ms @@ -426,6 +426,7 @@ [(list-of-symbols) '(a b c) '("a") #f] [(maybe-binary-output-port) *binary-output-port *binary-input-port (current-output-port)] [(maybe-char) #\a 0] + [(maybe-force-host-out?) #t 0] [(maybe-pathname) "a" 'a] [(maybe-procedure) values 0] [(maybe-rtd) *rtd *record ""] diff --git a/racket/src/ChezScheme/s/compile.ss b/racket/src/ChezScheme/s/compile.ss index e178ba9f3e..efdccfcd97 100644 --- a/racket/src/ChezScheme/s/compile.ss +++ b/racket/src/ChezScheme/s/compile.ss @@ -2227,17 +2227,20 @@ (set-who! compile-to-file (rec compile-to-file (case-lambda - [(sexpr* out) (compile-to-file sexpr* out #f)] - [(sexpr* out sfd) + [(sexpr* out) (compile-to-file sexpr* out #f #f)] + [(sexpr* out sfd) (compile-to-file sexpr* out sfd #f)] + [(sexpr* out sfd force-host-out?) (unless (list? sexpr*) ($oops who "~s is not a proper list" sexpr*)) (unless (string? out) ($oops who "~s is not a string" out)) (when sfd (unless (source-file-descriptor? sfd) ($oops who "~s is not a source-file descriptor or #f" sfd))) + (unless (boolean? force-host-out?) ($oops who "~s is not a boolean" force-host-out?)) (let ([library? (and (= (length sexpr*) 1) (pair? (car sexpr*)) (eq? (caar sexpr*) 'library))] [program? (and (= (length sexpr*) 1) (pair? (car sexpr*)) (eq? (caar sexpr*) 'top-level-program))]) (define (go) (do-compile-to-file who out (and library? - (not (eq? (constant machine-type-name) (machine-type))) + (or force-host-out? + (not (eq? (constant machine-type-name) (machine-type)))) (format "~a.~s" (path-root out) (machine-type))) (constant machine-type-name) sfd diff --git a/racket/src/ChezScheme/s/primdata.ss b/racket/src/ChezScheme/s/primdata.ss index 2c65a56cbf..cde8a32ac1 100644 --- a/racket/src/ChezScheme/s/primdata.ss +++ b/racket/src/ChezScheme/s/primdata.ss @@ -1238,7 +1238,7 @@ (compile-script [sig [(pathname) (pathname pathname) (pathname pathname sub-symbol) -> (void)]] [flags true]) (compile-time-value? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard]) (compile-time-value-value [sig [(compile-time-value) -> (ptr)]] [flags pure mifoldable discard]) - (compile-to-file [sig [(list pathname) (list pathname maybe-sfd) -> (void/list)]] [flags true]) + (compile-to-file [sig [(list pathname) (list pathname maybe-sfd) (list pathname maybe-sfd maybe-force-host-out?) -> (void/list)]] [flags true]) (compile-to-port [sig [(list binary-output-port) (list binary-output-port maybe-sfd) (list binary-output-port maybe-sfd maybe-binary-output-port) (list binary-output-port maybe-sfd maybe-binary-output-port maybe-textual-output-port) (list binary-output-port maybe-sfd maybe-binary-output-port maybe-textual-output-port sub-symbol) (list binary-output-port maybe-sfd maybe-binary-output-port maybe-textual-output-port sub-symbol maybe-binary-output-port) (list binary-output-port maybe-sfd maybe-binary-output-port maybe-textual-output-port sub-symbol maybe-binary-output-port ptr) (list binary-output-port maybe-sfd maybe-binary-output-port maybe-textual-output-port sub-symbol maybe-binary-output-port ptr ptr) -> (void/list)]] [flags true]) (compile-whole-program [sig [(string string) (string string ptr) -> (void)]] [flags]) (compile-whole-library [sig [(string string) -> (void)]] [flags]) diff --git a/racket/src/cs/compile-file.ss b/racket/src/cs/compile-file.ss index 1bb715f04a..6a8a6d295a 100644 --- a/racket/src/cs/compile-file.ss +++ b/racket/src/cs/compile-file.ss @@ -145,7 +145,8 @@ (let ([e (map annotation-expression (annotation-expression e))]) (cons e (loop pos))))))))]) - (compile-to-file exprs dest)))] + ;; Pass #t for `force-host-out?' in case host and target are the same. + (compile-to-file exprs dest #f #t)))] [else ;; Normal mode (compile-file src dest)]))]))