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

ios: constrain recent allocation segments generation, fix for tarm64->tarm64 cross-compilation

Browse Source 
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.
This commit is contained in:
Bogdan Popa 2021-01-18 16:53:54 +02:00 committed by GitHub
parent 764b552ac5
commit 6b0b3e0a1e
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
7 changed files with 17 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
racket/src/ChezScheme/c/alloc.c
View File

@ -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;

10
racket/src/ChezScheme/c/segment.c
View File

@ -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");
}
}
}
}

1
racket/src/ChezScheme/c/thread.c
View File

@ -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;
}

1
racket/src/ChezScheme/mats/primvars.ms
View File

@ -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 ""]

9
racket/src/ChezScheme/s/compile.ss
View File

@ -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

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

@ -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])

3
racket/src/cs/compile-file.ss
View File

@ -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)]))]))