continuation-attachment performance
Add a shortcut check when refiying the continuation frame in tail
position, which is significantly cheaper when the frame is already
there. We pay down the check by skipping an attachment-lists check
that is not needed if the frame is newly reified.
Aslo, add a one-shot continuation-frame cache, which makes a shallow
temporary attachment cheaper, as in
(let loop ([i N])
(if (zero? i)
0
(loop (call-setting-continuation-attachment
i
(lambda ()
(f (sub1 i)))))))
The cache is just one frame. Keeping a chain of allocated-by-not-GCed
frames doesn't pay off.
Meanwhile, remove the leftover `$shift-attachment` library entry.
original commit: 1f454f536b1d7efe20fe9e793cda31e54e31e5f4
This commit is contained in:
Matthew Flatt
parent
502b0b5f50
commit
b842a134fd
1
c/gc.c
1
c/gc.c
|
|
@ -1842,6 +1842,7 @@ static void sweep_thread(p) ptr p; {
|
|||
/* iptr SCHEMESTACKSIZE */
|
||||
relocate(&WINDERS(tc))
|
||||
relocate(&ATTACHMENTS(tc))
|
||||
CACHEDFRAME(tc) = Sfalse;
|
||||
relocate_return_addr(&FRAME(tc,0))
|
||||
sweep_stack((uptr)SCHEMESTACK(tc), (uptr)SFP(tc), (uptr)FRAME(tc,0));
|
||||
relocate(&U(tc))
|
||||
|
|
|
|||
|
|
@ -81,6 +81,7 @@ ptr S_create_thread_object(who, p_tc) const char *who; ptr p_tc; {
|
|||
|
||||
WINDERS(tc) = Snil;
|
||||
ATTACHMENTS(tc) = Snil;
|
||||
CACHEDFRAME(tc) = Sfalse;
|
||||
STACKLINK(tc) = SYMVAL(S_G.null_continuation_id);
|
||||
STACKCACHE(tc) = Snil;
|
||||
|
||||
|
|
|
|||
|
|
@ -1379,6 +1379,7 @@
|
|||
[iptr scheme-stack-size]
|
||||
[ptr winders]
|
||||
[ptr attachments]
|
||||
[ptr cached-frame]
|
||||
[ptr U]
|
||||
[ptr V]
|
||||
[ptr W]
|
||||
|
|
@ -2696,7 +2697,6 @@
|
|||
($wrapper-apply #f 0 #f #f)
|
||||
(wrapper-apply #f 0 #f #f)
|
||||
(arity-wrapper-apply #f 0 #f #f)
|
||||
($shift-attachment #f 0 #f #f)
|
||||
))
|
||||
|
||||
(let ()
|
||||
|
|
|
|||
|
|
@ -5575,8 +5575,7 @@
|
|||
(define hand-coded-closure?
|
||||
(lambda (name)
|
||||
(not (memq name '(nuate nonprocedure-code error-invoke invoke
|
||||
$wrapper-apply wrapper-apply arity-wrapper-apply
|
||||
$shift-attachment)))))
|
||||
$wrapper-apply wrapper-apply arity-wrapper-apply)))))
|
||||
(define-inline 2 $hand-coded
|
||||
[(name)
|
||||
(nanopass-case (L7 Expr) name
|
||||
|
|
@ -11574,6 +11573,7 @@
|
|||
(set! ,(%tc-ref scheme-stack) ,(%mref ,xp/cp ,(constant continuation-stack-disp)))
|
||||
(set! ,(%tc-ref stack-link) ,(%mref ,xp/cp ,(constant continuation-link-disp)))
|
||||
(set! ,%ts ,(%mref ,xp/cp ,(constant continuation-attachments-disp)))
|
||||
(set! ,(%tc-ref cached-frame) ,xp/cp) ; save for fast immediate realloc
|
||||
(set! ,(%tc-ref attachments) ,%ts)
|
||||
(goto ,Lreturn))
|
||||
; can't merge
|
||||
|
|
@ -11666,9 +11666,18 @@
|
|||
,(%inline eq? ,%ref-ret ,%ac0))
|
||||
,(finish %td)
|
||||
,(%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))))
|
||||
,(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))
|
||||
|
|
@ -12004,13 +12013,24 @@
|
|||
(set! ,ats ,(%mref ,ats ,(constant pair-cdr-disp)))
|
||||
,(make-push))]
|
||||
[(reify-and-set)
|
||||
(%seq
|
||||
(set! ,%td (inline ,(intrinsic-info-asmlib reify-cc #f) ,%asmlibcall))
|
||||
(set! ,ats ,(%tc-ref attachments))
|
||||
(if ,(%inline eq? ,(%mref ,%td ,(constant continuation-attachments-disp)) ,ats)
|
||||
(nop)
|
||||
(set! ,ats ,(%mref ,ats ,(constant pair-cdr-disp))))
|
||||
,(make-push))]
|
||||
(let ([tmp (make-tmp 'uf)])
|
||||
(%seq
|
||||
;; Fast check for existing reified, first
|
||||
(set! ,%td ,(%tc-ref stack-link))
|
||||
(set! ,tmp (literal ,(make-info-literal #f 'library-code
|
||||
(lookup-libspec dounderflow)
|
||||
(fx+ (constant code-data-disp) (constant size-rp-header)))))
|
||||
(set! ,ats ,(%tc-ref attachments))
|
||||
(if (if ,(%inline eq?
|
||||
,(%mref ,%td ,(constant continuation-attachments-disp))
|
||||
,(%constant sfalse))
|
||||
(false)
|
||||
,(%inline eq? ,%ref-ret ,tmp))
|
||||
(if ,(%inline eq? ,(%mref ,%td ,(constant continuation-attachments-disp)) ,ats)
|
||||
(nop)
|
||||
(set! ,ats ,(%mref ,ats ,(constant pair-cdr-disp))))
|
||||
(set! ,%td (inline ,(intrinsic-info-asmlib reify-cc #f) ,%asmlibcall)))
|
||||
,(make-push)))]
|
||||
[else
|
||||
($oops who "unexpected attachment-set mode ~s" aop)]))])
|
||||
(Tail : Tail (ir) -> Tail ()
|
||||
|
|
@ -12941,32 +12961,6 @@
|
|||
(set! ,(ref-reg %cp) ,%td)
|
||||
(jump ,(%mref ,%td ,(constant closure-code-disp))
|
||||
(,%ac0 ,(reg-cons* %ret arg-registers) ...)))))])))]
|
||||
[($shift-attachment)
|
||||
;; Reify the continuation, but dropping the first `attachments` element,
|
||||
;; which must be present, so that the attachment will be popped
|
||||
;; on return from the continuation
|
||||
(let ([info (make-info "$shift-attachment" '())])
|
||||
(info-lambda-fv*-set! info '(proc))
|
||||
`(lambda ,info 0 ()
|
||||
,(%seq
|
||||
(set! ,(ref-reg %ac1) ,%ac0) ; save argument count
|
||||
(set! ,%td (inline ,(intrinsic-info-asmlib reify-cc #f) ,%asmlibcall))
|
||||
(set! ,%ts ,(%mref ,%td ,(constant continuation-attachments-disp)))
|
||||
(set! ,(%mref ,%td ,(constant continuation-attachments-disp)) ,(%mref ,%ts ,(constant pair-cdr-disp)))
|
||||
(set! ,%ac0 ,(ref-reg %ac1)) ; restore argument count
|
||||
,(meta-cond
|
||||
[(real-register? '%cp)
|
||||
(%seq
|
||||
(set! ,%cp ,(%mref ,%cp ,(constant closure-data-disp)))
|
||||
(jump ,(%mref ,%cp ,(constant closure-code-disp))
|
||||
(,%ac0 ,%cp ,(reg-cons* %ret arg-registers) ...)))]
|
||||
[else
|
||||
(%seq
|
||||
(set! ,%td ,(ref-reg %cp))
|
||||
(set! ,%td ,(%mref ,%td ,(constant closure-data-disp)))
|
||||
(set! ,(ref-reg %cp) ,%td)
|
||||
(jump ,(%mref ,%td ,(constant closure-code-disp))
|
||||
(,%ac0 ,(reg-cons* %ret arg-registers) ...)))]))))]
|
||||
[(bytevector=?)
|
||||
(let ([bv1 (make-tmp 'bv1)] [bv2 (make-tmp 'bv2)] [idx (make-tmp 'idx)] [len2 (make-tmp 'len2)])
|
||||
(define (argcnt->max-fv n) (max (- n (length arg-registers)) 0))
|
||||
|
|
|
|||
|
|
@ -126,7 +126,6 @@
|
|||
(define-hand-coded-library-entry dofretu32*)
|
||||
(define-hand-coded-library-entry domvleterr)
|
||||
(define-hand-coded-library-entry values-error)
|
||||
(define-hand-coded-library-entry $shift-attachment)
|
||||
(define-hand-coded-library-entry bytevector=?)
|
||||
(define-hand-coded-library-entry $wrapper-apply)
|
||||
(define-hand-coded-library-entry wrapper-apply)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user