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

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

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

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

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

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

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

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