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

cify repairs

Browse Source 
Fix liveness for "simple" arguments to inlined functions. Fix
handling of non-authrntic structure access and mutation to
allow the possibility of a GC.
This commit is contained in:
Matthew Flatt 2018-08-09 17:41:45 -06:00
parent 3dd402937b
commit fac3c6fbc6
6 changed files with 43 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
racket/src/cify/generate.rkt
View File

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

20
racket/src/cify/inline.rkt
View File

@ -57,15 +57,19 @@
(define k (hash-ref knowns rator #f))
(cond
[(and (struct-accessor? k) (= n 1))
(lambda (s)
(if (struct-info-authentic? (struct-accessor-si k))
(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)))))]
(define authentic? (struct-info-authentic? (struct-accessor-si k)))
(and (or can-gc? authentic?)
(lambda (s)
(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)
(if (struct-info-authentic? (struct-mutator-si k))
(format "c_authentic_struct_set(~a, ~a)" s (struct-mutator-pos k))
(and can-gc? (format "c_struct_set(~a, ~a)" s (struct-mutator-pos k)))))]
(define authentic? (struct-info-authentic? (struct-mutator-si k)))
(and (or can-gc? authentic?)
(lambda (s)
(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)

15
racket/src/cify/runstack.rkt
View File

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

15
racket/src/cify/simple.rkt
View File

@ -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)
(values saw (hash-set shared id (genid 'c_simple)))
(values (hash-set saw id e) shared))]
(define saw-e (hash-ref saw id #f))
(define new-saw (if saw-e saw (hash-set saw id e)))
(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))]

4
racket/src/cs/linklet.sls
View File

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

3
racket/src/cs/linklet/performance.ss
View File

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