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

add functions to traverse a continuation without splitting

Browse Source 
original commit: 0f3ff69d4247ec695087953892839d680ed32fff
This commit is contained in:
Matthew Flatt 2020-07-01 08:28:27 -06:00
parent 42c4a90e7c
commit ac0b1f71ca
5 changed files with 98 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
makefiles/Mf-install.in
View File

@ -62,7 +62,7 @@ InstallLZ4Target=
# no changes should be needed below this point #
###############################################################################
Version=csv9.5.3.30
Version=csv9.5.3.31
Include=boot/$m
PetiteBoot=boot/$m/petite.boot
SchemeBoot=boot/$m/scheme.boot

2
s/cmacros.ss
View File

@ -328,7 +328,7 @@
[(_ foo e1 e2) e1] ...
[(_ bar e1 e2) e2]))))])))
(define-constant scheme-version #x0905031E)
(define-constant scheme-version #x0905031F)
(define-syntax define-machine-types
(lambda (x)

91
s/cpnanopass.ss
View File

@ -10173,38 +10173,71 @@
(translate (%mref ,e ,(constant continuation-stack-clength-disp))
(constant fixnum-offset)
(constant log2-ptr-bytes))])
(define-inline 3 $continuation-return-code
[(e)
(bind #t ([ra (%mref ,e ,(constant continuation-return-address-disp))])
(bind #t ([t `(if ,(%inline logtest ,(%mref ,ra ,(constant compact-return-address-mask+size+mode-disp))
,(%constant compact-header-mask))
,(%inline + ,ra ,(%constant compact-return-address-toplink-disp))
,(%inline + ,ra ,(%constant return-address-toplink-disp)))])
(%inline - ,t ,(%mref ,t 0))))])
(define-inline 3 $continuation-return-offset
[(e)
(bind #t ([ra (%mref ,e ,(constant continuation-return-address-disp))])
(build-fix
`(if ,(%inline logtest ,(%mref ,ra ,(constant compact-return-address-mask+size+mode-disp))
,(%constant compact-header-mask))
,(%inline - ,(%mref ,ra ,(constant compact-return-address-toplink-disp))
,(%constant compact-return-address-toplink-disp))
,(%inline - ,(%mref ,ra ,(constant return-address-toplink-disp))
,(%constant return-address-toplink-disp)))))])
(define-inline 3 $continuation-return-livemask
[(e)
(bind #t ([ra (%mref ,e ,(constant continuation-return-address-disp))])
(bind #t ([mask+size+mode (%mref ,ra ,(constant compact-return-address-mask+size+mode-disp))])
`(if ,(%inline logtest ,mask+size+mode ,(%constant compact-header-mask))
,(%inline sll ,(%inline srl ,mask+size+mode ,(%constant compact-frame-mask-offset)),
(%constant fixnum-offset))
,(%mref ,ra ,(constant return-address-livemask-disp)))))])
(define-inline 3 $continuation-stack-ref
[(e-k e-i)
(%mref
(let ()
(define (build-ra e)
(%mref ,e ,(constant continuation-return-address-disp)))
(define (build-stack-ra e-k e-i)
(%mref ,(%mref ,e-k ,(constant continuation-stack-disp))
,(translate e-i (constant fixnum-offset) (constant log2-ptr-bytes))
0))
(define build-return-code
(lambda (e-ra)
(bind #t ([ra e-ra])
(bind #t ([t `(if ,(%inline logtest ,(%mref ,ra ,(constant compact-return-address-mask+size+mode-disp))
,(%constant compact-header-mask))
,(%inline + ,ra ,(%constant compact-return-address-toplink-disp))
,(%inline + ,ra ,(%constant return-address-toplink-disp)))])
(%inline - ,t ,(%mref ,t 0))))))
(define build-return-offset
(lambda (e-ra)
(bind #t ([ra e-ra])
(build-fix
`(if ,(%inline logtest ,(%mref ,ra ,(constant compact-return-address-mask+size+mode-disp))
,(%constant compact-header-mask))
,(%inline - ,(%mref ,ra ,(constant compact-return-address-toplink-disp))
,(%constant compact-return-address-toplink-disp))
,(%inline - ,(%mref ,ra ,(constant return-address-toplink-disp))
,(%constant return-address-toplink-disp)))))))
(define build-return-livemask
(lambda (e-ra)
(bind #t ([ra e-ra])
(bind #t ([mask+size+mode (%mref ,ra ,(constant compact-return-address-mask+size+mode-disp))])
`(if ,(%inline logtest ,mask+size+mode ,(%constant compact-header-mask))
,(%inline sll ,(%inline srl ,mask+size+mode ,(%constant compact-frame-mask-offset))
,(%constant fixnum-offset))
,(%mref ,ra ,(constant return-address-livemask-disp)))))))
(define build-return-frame-words
(lambda (e-ra)
(bind #t ([ra e-ra])
(bind #t ([mask+size+mode (%mref ,ra ,(constant compact-return-address-mask+size+mode-disp))])
`(if ,(%inline logtest ,mask+size+mode ,(%constant compact-header-mask))
,(%inline sll ,(%inline logand ,(%inline srl ,mask+size+mode ,(%constant compact-frame-words-offset))
,(%constant compact-frame-words-mask))
,(%constant fixnum-offset))
,(%mref ,ra ,(constant return-address-frame-size-disp)))))))
(define-inline 3 $continuation-return-code
[(e) (build-return-code (build-ra e))])
(define-inline 3 $continuation-return-offset
[(e) (build-return-offset (build-ra e))])
(define-inline 3 $continuation-return-livemask
[(e) (build-return-livemask (build-ra e))])
(define-inline 3 $continuation-return-frame-words
[(e) (build-return-frame-words (build-ra e))])
(define-inline 3 $continuation-stack-ref
[(e-k e-i)
(%mref
,(%mref ,e-k ,(constant continuation-stack-disp))
,(translate e-i (constant fixnum-offset) (constant log2-ptr-bytes))
0)])
(define-inline 3 $continuation-stack-return-code
[(e-k e-i) (build-return-code (build-stack-ra e-k e-i))])
(define-inline 3 $continuation-stack-return-offset
[(e-k e-i) (build-return-offset (build-stack-ra e-k e-i))])
(define-inline 3 $continuation-stack-return-frame-words
[(e-k e-i) (build-return-frame-words (build-stack-ra e-k e-i))]))
(define-inline 2 $foreign-char?
[(e)
(bind #t (e)

4
s/primdata.ss
View File

@ -1870,11 +1870,15 @@
($continuation? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable])
($continuation-link [flags single-valued])
($continuation-return-code [flags single-valued])
($continuation-return-frame-words [flags single-valued])
($continuation-return-livemask [flags single-valued])
($continuation-return-offset [flags single-valued])
($continuation-stack-clength [flags single-valued])
($continuation-stack-length [flags single-valued])
($continuation-stack-ref [flags single-valued])
($continuation-stack-return-code [flags single-valued])
($continuation-stack-return-offset [flags single-valued])
($continuation-stack-return-frame-words [flags single-valued])
($continuation-winders [flags single-valued])
($continuation-attachments [flags single-valued])
($cp0 [flags single-valued])

30
s/prims.ss
View File

@ -616,6 +616,36 @@
($oops '$continuation-return-offset "~s is not a continuation" x))
($continuation-return-offset x)))
(define-who $continuation-return-frame-words
(lambda (x)
(unless ($continuation? x)
($oops who "~s is not a continuation" x))
($continuation-return-frame-words x)))
(define-who $continuation-stack-return-code
(lambda (x i)
(unless ($continuation? x)
($oops who "~s is not a continuation" x))
(unless (and (fixnum? i) (fx< 0 i ($continuation-stack-clength x)))
($oops who "invalid index ~s" i))
($continuation-stack-return-code x i)))
(define-who $continuation-stack-return-offset
(lambda (x i)
(unless ($continuation? x)
($oops who "~s is not a continuation" x))
(unless (and (fixnum? i) (fx< 0 i ($continuation-stack-clength x)))
($oops who "invalid index ~s" i))
($continuation-stack-return-offset x i)))
(define-who $continuation-stack-return-frame-words
(lambda (x i)
(unless ($continuation? x)
($oops who "~s is not a continuation" x))
(unless (and (fixnum? i) (fx< 0 i ($continuation-stack-clength x)))
($oops who "invalid index ~s" i))
($continuation-stack-return-frame-words x i)))
(define void
(lambda ()
(void)))