cify repairs

Fix liveness for "simple" arguments to inlined functions. Fix
handling of non-authrntic structure access and mutation to
allow the possibility of a GC.

racket/src/cify/generate.rkt

@@ -318,15 +318,16 @@
                        (format "~a =" (cify tst-id))
                        (make-runstack-assign runstack tst-id))
                    tst env))
-       (when sync-for-gc?
-         (runstack-sync! runstack))
        (call-with-simple-shared
         (cons 'begin (for/list ([tst-id (in-list tst-ids)]
                                 [tst (in-list tsts)]
                                 #:when (not tst-id))
                        tst))
         runstack state
+        #:about-to-sync? sync-for-gc?
         (lambda (shared)
+          (when sync-for-gc?
+            (runstack-sync! runstack))
           (out-open "if (~a) {"
                     (wrapper (apply string-append
                                     (add-between
@@ -566,15 +567,16 @@
       (when tmp-id
         (generate (make-runstack-assign runstack tmp-id)
                   rand env)))
-    (when need-sync?
-      (runstack-sync! runstack))
     (define inline-app (cons rator (for/list ([tmp-id (in-list tmp-ids)]
                                               [rand (in-list rands)])
                                      (or tmp-id rand))))
     (call-with-simple-shared
      inline-app
      runstack state
+     #:about-to-sync? need-sync?
      (lambda (shared)
+       (when need-sync?
+         (runstack-sync! runstack))
        (define s (generate-simple inline-app shared env runstack in-lam state top-names knowns prim-names))
        (return ret runstack #:can-pre-pop? #t s)
        (runstack-pop! runstack tmp-count)))

racket/src/cify/inline.rkt

@@ -57,15 +57,19 @@
         (define k (hash-ref knowns rator #f))
         (cond
           [(and (struct-accessor? k) (= n 1))
-           (lambda (s)
+           (define authentic? (struct-info-authentic? (struct-accessor-si k)))
-             (if (struct-info-authentic? (struct-accessor-si k))
+           (and (or can-gc? authentic?)
-                 (format "c_authentic_struct_ref(~a, ~a)" s (struct-accessor-pos k))
+                (lambda (s)
-                 (and can-gc? (format "c_struct_ref(~a, ~a)" s (struct-accessor-pos k)))))]
+                  (if authentic?
+                      (format "c_authentic_struct_ref(~a, ~a)" s (struct-accessor-pos k))
+                      (and can-gc? (format "c_struct_ref(~a, ~a)" s (struct-accessor-pos k))))))]
           [(and (struct-mutator? k) (= n 2))
-           (lambda (s)
+           (define authentic? (struct-info-authentic? (struct-mutator-si k)))
-             (if (struct-info-authentic? (struct-mutator-si k))
+           (and (or can-gc? authentic?)
-                 (format "c_authentic_struct_set(~a, ~a)" s (struct-mutator-pos k))
+                (lambda (s)
-                 (and can-gc? (format "c_struct_set(~a, ~a)" s (struct-mutator-pos k)))))]
+                  (if authentic?
+                      (format "c_authentic_struct_set(~a, ~a)" s (struct-mutator-pos k))
+                      (format "c_struct_set(~a, ~a)" s (struct-mutator-pos k)))))]
           [(and (struct-property-accessor? k) (= n 1))
            (and can-gc?
                 (lambda (s top-ref)

racket/src/cify/runstack.rkt

@@ -99,9 +99,12 @@
         (set-runstack-depth! rs (- (runstack-depth rs) 1))
         (hash-remove! (runstack-need-inits rs) var)
         (when (hash-ref (runstack-unsynced rs) var #f)
-          (when track-local?
-            (hash-set! (runstack-rs-state rs) var 'local))
           (hash-remove! (runstack-unsynced rs) var))
+        (when (and track-local?
+                   ;; If all references were pre-sync, it can be local
+                   (for/and ([state (in-hash-values (hash-ref (runstack-all-refs rs) var '#hasheq()))])
+                     (eq? state 'pre-sync)))
+          (hash-set! (runstack-rs-state rs) var 'local))
         (let ([refs (hash-ref (runstack-unsynced-refs rs) var '())])
           (hash-remove! (runstack-unsynced-refs rs) var)
           (for ([ref (in-list refs)])
@@ -132,7 +135,10 @@
       s))
 
 (define (runstack-ref-use! rs ref)
-  (set-runstack-all-refs! rs (hash-set2 (runstack-all-refs rs) (ref-id ref) ref #t)))
+  (set-runstack-all-refs! rs (hash-set2 (runstack-all-refs rs) (ref-id ref) ref
+                                        (if (hash-ref (runstack-unsynced rs) (ref-id ref) #f)
+                                            'pre-sync
+                                            'post-sync))))
 
 (define (runstack-assign rs id)
   (hash-remove! (runstack-need-inits rs) id)
@@ -283,5 +289,6 @@
 
 (define (runstack-generate-staged-clears! rs)
   (for ([(id get-pos) (in-sorted-hash (runstack-staged-clears rs) symbol<?)])
-    (out "c_no_use(c_runbase, ~a);" (get-pos)))
+    (unless (eq? (hash-ref (runstack-var-depths rs) id) 'local)
+      (out "c_no_use(c_runbase, ~a);" (get-pos))))
   (set-runstack-staged-clears! rs #hasheq()))

racket/src/cify/simple.rkt

@@ -33,18 +33,23 @@
                (simple? e)))))
   (simple? e))
 
-(define (call-with-simple-shared e runstack state proc)
+(define (call-with-simple-shared e runstack state proc
+                                 #:about-to-sync? [about-to-sync? #f])
   ;; If a runstack variable is referenced twice, lift out and share
   ;; the reference to avoid relying on an order within the simple
-  ;; expression
+  ;; expression. If `about-to-sync?` is #t, then also lift out any
+  ;; reference to variables.
   (define-values (saw shared)
     (let loop ([e e] [saw #hasheq()] [shared #hasheq()])
       (cond
         [(ref? e)
          (define id (ref-id e))
-         (if (hash-ref saw id #f)
+         (define saw-e (hash-ref saw id #f))
-             (values saw (hash-set shared id (genid 'c_simple)))
+         (define new-saw (if saw-e saw (hash-set saw id e)))
-             (values (hash-set saw id e) shared))]
+         (values new-saw
+                 (if (or saw-e about-to-sync?)
+                     (hash-set shared id (genid 'c_simple))
+                     shared))]
         [(pair? e)
          (for/fold ([saw saw] [shared shared]) ([e (cdr e)])
            (loop e saw shared))]

racket/src/cs/linklet.sls

@@ -462,7 +462,7 @@
                                            ;; Compile an individual `lambda`:
                                            (lambda (expr arity-mask name)
                                              (performance-region
-                                              'compile
+                                              'compile-nested
                                               (let ([code ((if serializable? compile*-to-bytevector compile*)
                                                            (show lambda-on? "lambda" (correlated->annotation expr)))])
                                                 (if serializable?
@@ -479,7 +479,7 @@
        (when known-on?
          (show "known" (hash-map exports-info (lambda (k v) (list k v)))))
        (performance-region
-        'compile
+        'compile-linklet
         ;; Create the linklet:
         (let ([lk (make-linklet (call-with-system-wind
                                  (lambda ()

racket/src/cs/linklet/performance.ss

@@ -57,7 +57,8 @@
            [gc-len (string-length (number->string gc-total))]
            [categories '((read (read-bundle faslin-code))
                          (comp-ffi (comp-ffi-call comp-ffi-back))
-                         (run (instantiate outer)))]
+                         (run (instantiate outer))
+                         (compile (compile-linklet compile-nested)))]
            [region-subs (make-eq-hashtable)]
            [region-gc-subs (make-eq-hashtable)])
       (define (pad v w combine)