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

skip unnecessary check for reified frame

Browse Source 
Since we've effectively inlined the check, make the
`reify-cc` intrinsic always just reify.

original commit: 747a8a0165c62f63cd6560dbaa9cc8b09fc9ec50
This commit is contained in:
Matthew Flatt 2019-09-19 12:10:24 -06:00
parent 4e3b829227
commit c2e78cd676
1 changed files with 55 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

103
s/cpnanopass.ss
View File

@ -11694,55 +11694,62 @@
(jump ,(%mref ,%xp ,(constant return-address-mv-return-address-disp)) (jump ,(%mref ,%xp ,(constant return-address-mv-return-address-disp))
(,%ac0 ,arg-registers ... ,fv0))))])))))))))))) (,%ac0 ,arg-registers ... ,fv0))))]))))))))))))
(define reify-cc-help (define reify-cc-help
(lambda (1-shot? finish) (lambda (1-shot? always? finish)
(with-output-language (L13 Tail) (with-output-language (L13 Tail)
(%seq (%seq
(set! ,%td ,(%tc-ref stack-link)) (set! ,%td ,(%tc-ref stack-link))
,(let ([build-reify ,(let* ([build-reify
(lambda () (lambda ()
(%seq (%seq
,(let ([alloc
(%seq
(set! ,%xp ,(%constant-alloc type-closure (constant size-continuation)))
(set! ,(%mref ,%xp ,(constant continuation-code-disp))
(literal ,(make-info-literal #f 'library (lookup-libspec nuate) (constant code-data-disp)))))])
(if 1-shot?
(%seq
(set! ,%xp ,(%tc-ref cached-frame))
(if ,(%inline eq? ,%xp ,(%constant sfalse))
,alloc
(set! ,(%tc-ref cached-frame) ,(%constant sfalse))))
alloc))
(set! ,(%mref ,%xp ,(constant continuation-return-address-disp)) ,%ref-ret)
(set! ,(%mref ,%xp ,(constant continuation-winders-disp)) ,(%tc-ref winders))
(set! ,(%mref ,%xp ,(constant continuation-attachments-disp)) ,(%tc-ref attachments))
(set! ,%ref-ret ,%ac0)
(set! ,(%mref ,%xp ,(constant continuation-link-disp)) ,%td)
(set! ,(%tc-ref stack-link) ,%xp)
(set! ,%ac0 ,(%tc-ref scheme-stack))
(set! ,(%tc-ref scheme-stack) ,%sfp)
(set! ,(%mref ,%xp ,(constant continuation-stack-disp)) ,%ac0)
(set! ,%ac0 ,(%inline - ,%sfp ,%ac0))
(set! ,(%mref ,%xp ,(constant continuation-stack-length-disp))
,(if 1-shot?
`(immediate ,(constant opportunistic-1-shot-flag))
%ac0))
(set! ,(%mref ,%xp ,(constant continuation-stack-clength-disp)) ,%ac0)
(set! ,(%tc-ref scheme-stack-size) ,(%inline - ,(%tc-ref scheme-stack-size) ,%ac0))
,(finish %xp)))]
[build-maybe-reify
(lambda ()
(%seq
(set! ,%ac0 (set! ,%ac0
(literal ,(make-info-literal #f 'library-code (literal ,(make-info-literal #f 'library-code
(lookup-libspec dounderflow) (lookup-libspec dounderflow)
(fx+ (constant code-data-disp) (constant size-rp-header))))) (fx+ (constant code-data-disp) (constant size-rp-header)))))
(if (if ,(%inline eq? ,(if always?
,(%mref ,%td ,(constant continuation-attachments-disp)) ;; No need to check
,(%constant sfalse)) (build-reify)
(false) ;; Check and build if needed
,(%inline eq? ,%ref-ret ,%ac0)) `(if (if ,(%inline eq?
,(finish %td) ,(%mref ,%td ,(constant continuation-attachments-disp))
,(%seq ,(%constant sfalse))
,(let ([alloc (false)
(%seq ,(%inline eq? ,%ref-ret ,%ac0))
(set! ,%xp ,(%constant-alloc type-closure (constant size-continuation))) ,(finish %td)
(set! ,(%mref ,%xp ,(constant continuation-code-disp)) ,(build-reify)))))])
(literal ,(make-info-literal #f 'library (lookup-libspec nuate) (constant code-data-disp)))))])
(if 1-shot?
(%seq
(set! ,%xp ,(%tc-ref cached-frame))
(if ,(%inline eq? ,%xp ,(%constant sfalse))
,alloc
(set! ,(%tc-ref cached-frame) ,(%constant sfalse))))
alloc))
(set! ,(%mref ,%xp ,(constant continuation-return-address-disp)) ,%ref-ret)
(set! ,(%mref ,%xp ,(constant continuation-winders-disp)) ,(%tc-ref winders))
(set! ,(%mref ,%xp ,(constant continuation-attachments-disp)) ,(%tc-ref attachments))
(set! ,%ref-ret ,%ac0)
(set! ,(%mref ,%xp ,(constant continuation-link-disp)) ,%td)
(set! ,(%tc-ref stack-link) ,%xp)
(set! ,%ac0 ,(%tc-ref scheme-stack))
(set! ,(%tc-ref scheme-stack) ,%sfp)
(set! ,(%mref ,%xp ,(constant continuation-stack-disp)) ,%ac0)
(set! ,%ac0 ,(%inline - ,%sfp ,%ac0))
(set! ,(%mref ,%xp ,(constant continuation-stack-length-disp))
,(if 1-shot?
`(immediate ,(constant opportunistic-1-shot-flag))
%ac0))
(set! ,(%mref ,%xp ,(constant continuation-stack-clength-disp)) ,%ac0)
(set! ,(%tc-ref scheme-stack-size) ,(%inline - ,(%tc-ref scheme-stack-size) ,%ac0))
,(finish %xp)))))])
(if 1-shot? (if 1-shot?
(build-reify) (build-maybe-reify)
;; Promote existing 1-shot to multishot before reifying ;; Promote existing 1-shot to multishot before reifying
(let ([Ltop (make-local-label 'Ltop)]) (let ([Ltop (make-local-label 'Ltop)])
(%seq (%seq
@ -11752,7 +11759,7 @@
(if ,(%inline eq? (if ,(%inline eq?
,(%mref ,%xp ,(constant continuation-stack-length-disp)) ,(%mref ,%xp ,(constant continuation-stack-length-disp))
,%ac0) ,%ac0)
,(build-reify) ,(build-maybe-reify)
,(%seq ,(%seq
(set! ,(%mref ,%xp ,(constant continuation-stack-length-disp)) ,%ac0) (set! ,(%mref ,%xp ,(constant continuation-stack-length-disp)) ,%ac0)
(set! ,%xp ,(%mref ,%xp ,(constant continuation-link-disp))) (set! ,%xp ,(%mref ,%xp ,(constant continuation-link-disp)))
@ -11829,7 +11836,7 @@
,(asm-enter ,(asm-enter
(%seq (%seq
(check-live ,other-reg* ...) (check-live ,other-reg* ...)
,(reify-cc-help #t ,(reify-cc-help #t #t
(lambda (reg) (lambda (reg)
(if (eq? reg %td) (if (eq? reg %td)
`(asm-return ,%td ,other-reg* ...) `(asm-return ,%td ,other-reg* ...)
@ -11840,7 +11847,7 @@
`(lambda ,(make-named-info-lambda 'callcc '(1)) 0 () `(lambda ,(make-named-info-lambda 'callcc '(1)) 0 ()
,(%seq ,(%seq
(set! ,(ref-reg %cp) ,(make-arg-opnd 1)) (set! ,(ref-reg %cp) ,(make-arg-opnd 1))
,(reify-cc-help #f ,(reify-cc-help #f #f
(lambda (reg) (lambda (reg)
(%seq (%seq
(set! ,(make-arg-opnd 1) ,reg) (set! ,(make-arg-opnd 1) ,reg)
@ -12093,7 +12100,7 @@
[(reify-and-set) [(reify-and-set)
(let ([tmp (make-tmp 'uf)]) (let ([tmp (make-tmp 'uf)])
(%seq (%seq
;; Fast check for existing reified, first ;; Check for existing reified, first
(set! ,%td ,(%tc-ref stack-link)) (set! ,%td ,(%tc-ref stack-link))
(set! ,tmp (literal ,(make-info-literal #f 'library-code (set! ,tmp (literal ,(make-info-literal #f 'library-code
(lookup-libspec dounderflow) (lookup-libspec dounderflow)