[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. release_1-9-8-35-g9a1
From: |
Andy Wingo |
Subject: |
[Guile-commits] GNU Guile branch, master, updated. release_1-9-8-35-g9a1c6f1 |
Date: |
Wed, 24 Feb 2010 16:45:00 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=9a1c6f1f0c6b07725a240160b79acc54303d7891
The branch, master has been updated
via 9a1c6f1f0c6b07725a240160b79acc54303d7891 (commit)
via 078014374c066f03975bd0ef008877c5236c75ec (commit)
via 6d804376e94d17cf013a415c4bd98d632f7a91b9 (commit)
via ac644098bf1573cfbb4ee032e6cd32a23ca168b6 (commit)
from cee1d22c3c10b1892c82a5758ef69cd6fc9aba31 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 9a1c6f1f0c6b07725a240160b79acc54303d7891
Author: Andy Wingo <address@hidden>
Date: Wed Feb 24 17:43:02 2010 +0100
rewind the dynamic state when entering a partial continuation
* libguile/control.c (cont_objcode):
* libguile/vm-i-system.c (partial-cont-call):
* libguile/vm.c (vm_reinstate_partial_continuation): Don't keep the
"external winds" in a partial continuation, as they aren't logically
part of the continuation. Reinstate the "internal winds" when entering
a partial continuation. Things seem to work!
commit 078014374c066f03975bd0ef008877c5236c75ec
Author: Andy Wingo <address@hidden>
Date: Wed Feb 24 16:56:45 2010 +0100
partial-cont-call works
* libguile/vm-i-system.c (partial-cont-call): Sync registers before
splatting a partial continuation, and cache them back afterwards.
* libguile/vm.c (vm_reinstate_partial_continuation): Actually implement,
except dynamic-wind.
commit 6d804376e94d17cf013a415c4bd98d632f7a91b9
Author: Andy Wingo <address@hidden>
Date: Wed Feb 24 16:56:05 2010 +0100
record IP in partial continuations
* libguile/control.c (reify_partial_continuation): Assert some
invariants, and record the IP as the MVRA of the continuation.
commit ac644098bf1573cfbb4ee032e6cd32a23ca168b6
Author: Andy Wingo <address@hidden>
Date: Wed Feb 24 00:32:07 2010 +0100
ensure non-escape-only prompts have a thunk application as their body
* module/language/tree-il/inline.scm (inline!): Fix indenting for
lambda-case. In an amusing turn of events, use the inliner to
de-inline prompt bodies, if the prompt is not escape-only.
-----------------------------------------------------------------------
Summary of changes:
libguile/control.c | 24 ++++++++----
libguile/vm-i-system.c | 10 +++--
libguile/vm.c | 59 +++++++++++++++++++++++++++++--
module/language/tree-il/inline.scm | 68 +++++++++++++++++++++++++-----------
4 files changed, 125 insertions(+), 36 deletions(-)
diff --git a/libguile/control.c b/libguile/control.c
index 25c9504..49a19cf 100644
--- a/libguile/control.c
+++ b/libguile/control.c
@@ -100,9 +100,8 @@ SCM_STATIC_OBJCODE (cont_objcode) = {
/* leave args on the stack */
/* 0 */ scm_op_object_ref, 0, /* push scm_vm_cont object */
/* 2 */ scm_op_object_ref, 1, /* push internal winds */
- /* 4 */ scm_op_object_ref, 2, /* push external winds */
- /* 6 */ scm_op_partial_cont_call, /* and go! */
- /* 7 */ scm_op_nop, /* pad to 8 bytes */
+ /* 4 */ scm_op_partial_cont_call, /* and go! */
+ /* 5 */ scm_op_nop, scm_op_nop, scm_op_nop, /* pad to 8 bytes */
/* 8 */
/* We could put some meta-info to say that this proc is a continuation. Not
sure
@@ -110,7 +109,7 @@ SCM_STATIC_OBJCODE (cont_objcode) = {
META_HEADER (19),
/* 0 */ scm_op_make_eol, /* bindings */
/* 1 */ scm_op_make_eol, /* sources */
- /* 2 */ scm_op_make_int8, 0, scm_op_make_int8, 7, /* arity: from ip 0 to ip
7 */
+ /* 2 */ scm_op_make_int8, 0, scm_op_make_int8, 5, /* arity: from ip 0 to ip
7 */
/* 6 */ scm_op_make_int8_0, /* the arity is 0 required args */
/* 7 */ scm_op_make_int8_0, /* 0 optionals */
/* 8 */ scm_op_make_true, /* and a rest arg */
@@ -144,15 +143,24 @@ reify_partial_continuation (SCM vm, SCM prompt, SCM
extwinds,
if (cookie >= 0 && SCM_PROMPT_REGISTERS (prompt)->cookie == cookie)
flags |= SCM_F_VM_CONT_REWINDABLE;
- /* NULL RA and MVRA, as those get set when the cont is reinstated */
- vm_cont = scm_i_vm_capture_stack (SCM_PROMPT_REGISTERS (prompt)->sp,
+ /* Since non-escape continuations should begin with a thunk application, the
+ first bit of the stack should be a frame, with the saved fp equal to the
fp
+ that was current when the prompt was made. */
+ if ((SCM*)(SCM_PROMPT_REGISTERS (prompt)->sp[1])
+ != SCM_PROMPT_REGISTERS (prompt)->fp)
+ abort ();
+
+ /* Capture from the top of the thunk application frame up to the end. Set an
+ MVRA only, as the post-abort code is in an MV context. */
+ vm_cont = scm_i_vm_capture_stack (SCM_PROMPT_REGISTERS (prompt)->sp + 4,
SCM_VM_DATA (vm)->fp,
SCM_VM_DATA (vm)->sp,
- NULL, NULL,
+ NULL,
+ SCM_VM_DATA (vm)->ip,
flags);
ret = scm_make_program (cont_objcode,
- scm_vector (scm_list_3 (vm_cont, intwinds,
extwinds)),
+ scm_vector (scm_list_2 (vm_cont, intwinds)),
SCM_BOOL_F);
SCM_SET_CELL_WORD_0 (ret,
SCM_CELL_WORD_0 (ret) | SCM_F_PROGRAM_IS_CONTINUATION);
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 09293be..04ef951 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -995,12 +995,14 @@ VM_DEFINE_INSTRUCTION (89, continuation_call,
"continuation-call", 0, -1, 0)
VM_DEFINE_INSTRUCTION (94, partial_cont_call, "partial-cont-call", 0, -1, 0)
{
- SCM vmcont, intwinds, extwinds;
- POP (extwinds);
+ SCM vmcont, intwinds;
POP (intwinds);
POP (vmcont);
-
- vm_reinstate_partial_continuation (vm, vmcont, intwinds, extwinds);
+ SYNC_REGISTER ();
+ vm_reinstate_partial_continuation (vm, vmcont, intwinds, sp + 1 - fp, fp);
+ CACHE_REGISTER ();
+ program = SCM_FRAME_PROGRAM (fp);
+ CACHE_PROGRAM ();
NEXT;
}
diff --git a/libguile/vm.c b/libguile/vm.c
index 572a710..6fecd60 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -229,10 +229,63 @@ vm_abort (SCM vm, size_t n, scm_t_int64 vm_cookie)
}
static void
-vm_reinstate_partial_continuation (SCM vm, SCM vm_cont, SCM intwinds,
- SCM extwinds)
+vm_reinstate_partial_continuation (SCM vm, SCM cont, SCM intwinds,
+ size_t n, SCM *argv)
{
- abort ();
+ struct scm_vm *vp;
+ struct scm_vm_cont *cp;
+ SCM *argv_copy, *base;
+ size_t i;
+
+ argv_copy = alloca (n * sizeof(SCM));
+ memcpy (argv_copy, argv, n * sizeof(SCM));
+
+ vp = SCM_VM_DATA (vm);
+ cp = SCM_VM_CONT_DATA (cont);
+ base = SCM_FRAME_UPPER_ADDRESS (vp->fp) + 1;
+
+#define RELOC(scm_p) (scm_p + cp->reloc + (base - cp->stack_base))
+
+ if ((base - vp->stack_base) + cp->stack_size + n + 1 > vp->stack_size)
+ {
+ /* puts ("FIXME: Need to expand"); */
+ abort ();
+ }
+
+ memcpy (base, cp->stack_base, cp->stack_size * sizeof (SCM));
+
+ /* now relocate frame pointers */
+ {
+ SCM *fp;
+ for (fp = RELOC (cp->fp);
+ SCM_FRAME_LOWER_ADDRESS (fp) > base;
+ fp = SCM_FRAME_DYNAMIC_LINK (fp))
+ SCM_FRAME_SET_DYNAMIC_LINK (fp, RELOC (SCM_FRAME_DYNAMIC_LINK (fp)));
+ }
+
+ vp->sp = base - 1 + cp->stack_size;
+ vp->fp = RELOC (cp->fp);
+ vp->ip = cp->mvra;
+
+#undef RELOC
+
+ /* now push args. ip is in a MV context. */
+ for (i = 0; i < n; i++)
+ {
+ vp->sp++;
+ *vp->sp = argv_copy[i];
+ }
+ vp->sp++;
+ *vp->sp = scm_from_size_t (n);
+
+ /* Finally, rewind the dynamic state. */
+ {
+ long delta = 0;
+ SCM newwinds = scm_i_dynwinds ();
+ for (; scm_is_pair (intwinds); intwinds = scm_cdr (intwinds), delta--)
+ newwinds = scm_cons (scm_car (intwinds), newwinds);
+ scm_dowinds (newwinds, delta);
+ }
}
diff --git a/module/language/tree-il/inline.scm
b/module/language/tree-il/inline.scm
index 905622d..4e3863e 100644
--- a/module/language/tree-il/inline.scm
+++ b/module/language/tree-il/inline.scm
@@ -111,28 +111,54 @@
(if (null? vars) body x))
((<lambda-case> req opt rest kw vars body alternate)
- (let ()
- (define (args-compatible? args vars)
- (let lp ((args args) (vars vars))
- (cond
- ((null? args) (null? vars))
- ((null? vars) #f)
- ((and (lexical-ref? (car args))
- (eq? (lexical-ref-gensym (car args)) (car vars)))
- (lp (cdr args) (cdr vars)))
- (else #f))))
+ (define (args-compatible? args vars)
+ (let lp ((args args) (vars vars))
+ (cond
+ ((null? args) (null? vars))
+ ((null? vars) #f)
+ ((and (lexical-ref? (car args))
+ (eq? (lexical-ref-gensym (car args)) (car vars)))
+ (lp (cdr args) (cdr vars)))
+ (else #f))))
- (and (not opt) (not kw) (not alternate)
- (record-case body
- ((<application> proc args)
- ;; (lambda args (apply (lambda ...) args)) => (lambda ...)
- (and (primitive-ref? proc)
- (eq? (primitive-ref-name proc) '@apply)
- (pair? args)
- (lambda? (car args))
- (args-compatible? (cdr args) vars)
- (lambda-body (car args))))
- (else #f)))))
+ (and (not opt) (not kw) (not alternate)
+ (record-case body
+ ((<application> proc args)
+ ;; (lambda args (apply (lambda ...) args)) => (lambda ...)
+ (and (primitive-ref? proc)
+ (eq? (primitive-ref-name proc) '@apply)
+ (pair? args)
+ (lambda? (car args))
+ (args-compatible? (cdr args) vars)
+ (lambda-body (car args))))
+ (else #f))))
+
+ ;; Actually the opposite of inlining -- if the prompt cannot be proven to
+ ;; be escape-only, ensure that its body is the application of a thunk.
+ ((<prompt> src tag body handler)
+ (define (escape-only? handler)
+ (and (pair? (lambda-case-req handler))
+ (let ((cont (car (lambda-case-vars handler))))
+ (tree-il-fold (lambda (leaf escape-only?)
+ (and escape-only?
+ (not
+ (and (lexical-ref? leaf)
+ (eq? (lexical-ref-gensym leaf)
cont)))))
+ (lambda (down escape-only?) escape-only?)
+ (lambda (up escape-only?) escape-only?)
+ #t
+ (lambda-case-body handler)))))
+ (define (make-thunk body)
+ (make-lambda #f '() (make-lambda-case #f '() #f #f #f '() '() body
#f)))
+
+ (if (or (and (application? body)
+ (lambda? (application-proc body))
+ (null? (application-args body)))
+ (escape-only? handler))
+ x
+ (make-prompt src tag
+ (make-application #f (make-thunk body) '())
+ handler)))
(else #f)))
(post-order! inline1 x))
hooks/post-receive
--
GNU Guile
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. release_1-9-8-35-g9a1c6f1,
Andy Wingo <=