mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

optimize dynamic-wind when we know winders are thunks

Browse source 
* libguile/vm-i-system.c (wind):
* module/language/tree-il/compile-glil.scm (flatten-lambda-case):
  Instead of making `wind' call `scm_thunk_p' on the winder and unwinder
  at runtime, make it the responsibility of the compiler to emit code to
  call thunk? and error, but only if the compiler cannot prove them to
  be thunks.

* libguile/vm-engine.c (vm_engine): Remove a now-unused error block.
This commit is contained in:
Andy Wingo 2012-03-03 21:46:38 +01:00
parent deaae8e9d7
commit d5dbe0c1d5
3 changed files with 28 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

8
libguile/vm-engine.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
/* Copyright (C) 2001, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@ -251,12 +251,6 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
/* shouldn't get here */
goto vm_error;
vm_error_not_a_thunk:
SYNC_ALL ();
scm_wrong_type_arg_msg ("dynamic-wind", 1, finish_args, "thunk");
/* shouldn't get here */
goto vm_error;
vm_error_no_values:
err_msg = scm_from_latin1_string ("Zero values returned to single-valued continuation");
finish_args = SCM_EOL;

14
libguile/vm-i-system.c
View file

@ -1616,17 +1616,9 @@ VM_DEFINE_INSTRUCTION (86, wind, "wind", 0, 2, 0)
SYNC_REGISTER ();
/* Push wind and unwind procedures onto the dynamic stack. Note that neither
are actually called; the compiler should emit calls to wind and unwind for
the normal dynamic-wind control flow. */
if (SCM_UNLIKELY (scm_is_false (scm_thunk_p (wind))))
{
finish_args = wind;
goto vm_error_not_a_thunk;
}
if (SCM_UNLIKELY (scm_is_false (scm_thunk_p (unwind))))
{
finish_args = unwind;
goto vm_error_not_a_thunk;
}
the normal dynamic-wind control flow. Also note that the compiler
should have inserted checks that they wind and unwind procs are
thunks, if it could not prove that to be the case. */
scm_dynstack_push_dynwind (&current_thread->dynstack, wind, unwind);
NEXT;
}

24
module/language/tree-il/compile-glil.scm
View file

@ -921,7 +921,31 @@
;; then proceed with returning or dropping or what-have-you, interacting
;; with RA and MVRA. What have you, I say.
((<dynwind> src winder pre body post unwinder)
(define (thunk? x)
(and (lambda? x)
(null? (lambda-case-gensyms (lambda-body x)))))
(define (make-wrong-type-arg x)
(make-primcall src 'scm-error
(list
(make-const #f 'wrong-type-arg)
(make-const #f "dynamic-wind")
(make-const #f "Wrong type (expecting thunk): ~S")
(make-primcall #f 'list (list x))
(make-primcall #f 'list (list x)))))
(define (emit-thunk-check x)
(comp-drop (make-conditional
src
(make-primcall src 'thunk? (list x))
(make-void #f)
(make-wrong-type-arg x))))
;; We know at this point that `winder' and `unwinder' are
;; constant expressions and can be duplicated.
(if (not (thunk? winder))
(emit-thunk-check winder))
(comp-push winder)
(if (not (thunk? unwinder))
(emit-thunk-check unwinder))
(comp-push unwinder)
(comp-drop pre)
(emit-code #f (make-glil-call 'wind 2))