mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-28 16:00:22 +02:00
Code Activity

dynamic-wind compilation to VM ops

Browse source 
* module/language/tree-il/primitives.scm: Resolve calls to dynamic-wind
  to <dynamic-wind>, thereby inlining the dynwind to VM ops, and
  allowing inline allocation of the body thunk.
This commit is contained in:
Andy Wingo 2010-01-31 20:30:46 +01:00
parent 1c297a3850
commit 1bf78495e9
1 changed files with 37 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

37
module/language/tree-il/primitives.scm
View file

@ -33,6 +33,7 @@
call-with-values @call-with-values
call-with-current-continuation @call-with-current-continuation
call/cc
dynamic-wind
values
eq? eqv? equal?
memq memv
@ -362,3 +363,39 @@
(bytevector-ieee-double-native-ref vec (* i 8)))
(define-primitive-expander f64vector-set! (vec i x)
(bytevector-ieee-double-native-set! vec (* i 8) x))
(hashq-set! *primitive-expand-table*
'dynamic-wind
(case-lambda
((src pre thunk post)
;; Here we will make concessions to the fact that our inliner is
;; lame, and add a hack.
(cond
((lambda? thunk)
(let ((PRE (gensym " pre"))
(POST (gensym " post")))
(make-let
src
'(pre post)
(list PRE POST)
(list pre post)
(make-dynamic-wind
src
(make-lexical-ref #f 'pre PRE)
(make-application #f thunk '())
(make-lexical-ref #f 'post POST)))))
(else
(let ((PRE (gensym " pre"))
(THUNK (gensym " thunk"))
(POST (gensym " post")))
(make-let
src
'(pre thunk post)
(list PRE THUNK POST)
(list pre thunk post)
(make-dynamic-wind
src
(make-lexical-ref #f 'pre PRE)
(make-application #f (make-lexical-ref #f 'thunk THUNK) '())
(make-lexical-ref #f 'post POST)))))))
(else #f)))