[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-448-gdd1c7de
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-448-gdd1c7de |
|
Date: |
Thu, 21 Nov 2013 20:24:05 +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=dd1c7decccd35dc37950310b403b8e45a658fea4
The branch, master has been updated
via dd1c7decccd35dc37950310b403b8e45a658fea4 (commit)
via bd63e5b2c3e28cc6db0b0bdc7ea9103b5688e085 (commit)
via b85cd20f80c94e4bd8e62363cf509cc9e2f6ede9 (commit)
via 350930756c0d1968e6b526bc8900a77fe8e8af58 (commit)
via 3506b1521e168a6fd7fb15e07e4eb950393b4fa8 (commit)
via e7f9ababe0532c9b086ffa6b3825d0dafc9364bc (commit)
via 55ee3607003702ef5c53994c6216b9f0f835e0f1 (commit)
via 4fcbc1b0d8207df2dafce5fa80b942366d0ed7ed (commit)
from 9b4c3ab5fa293310a7853d99768426b7dba4005b (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 dd1c7decccd35dc37950310b403b8e45a658fea4
Author: Andy Wingo <address@hidden>
Date: Thu Nov 21 21:15:58 2013 +0100
Setjmp before calling into the VM
* libguile/vm-engine.c (CACHE_REGISTER): Remove an unneeded cast.
(VM_NAME):
* libguile/vm.c (scm_call_n): Setjmp out here. This leaves the VM
without any initialization work to do. It also makes it possible to
restart the VM in another mode (with hooks, for example).
commit bd63e5b2c3e28cc6db0b0bdc7ea9103b5688e085
Author: Andy Wingo <address@hidden>
Date: Thu Nov 21 19:05:43 2013 +0100
scm_call_n sets up boot continuation frame for VM
* libguile/vm-engine.c:
* libguile/vm.c (scm_call_n): Move boot continuation setup to
scm_call_n, so that vm-engine takes all of its state from the vp.
commit b85cd20f80c94e4bd8e62363cf509cc9e2f6ede9
Author: Andy Wingo <address@hidden>
Date: Thu Nov 21 18:50:12 2013 +0100
scm_call_n avoids double TLS lookup
* libguile/vm-engine.c (VM_NAME): Take the current thread as an
argument.
* libguile/vm.c (scm_i_capture_current_stack): Call thread_vm.
(thread_vm): New helper.
(scm_the_vm): Call thread_vm.
(scm_call_n): Call thread_vm. Avoids a double TLS lookup.
commit 350930756c0d1968e6b526bc8900a77fe8e8af58
Author: Andy Wingo <address@hidden>
Date: Thu Nov 21 18:37:52 2013 +0100
Remove scm_tc7_vm
* libguile/tags.h (scm_tc7_vm): Return to pool.
* libguile/goops.c:
* libguile/gc.c (scm_i_tag_name):
* libguile/evalext.c (scm_self_evaluating_p):
* libguile/print.c (iprin1): Remove tc7_vm things.
* libguile/vm.h (scm_the_vm_fluid): Remove stray declaration. Remove
SCM_VM_P. Remove SCM_VM_DATA. Remove SCM_VALIDATE_VM.
* libguile/vm.c (scm_i_vm_print): Remove.
commit 3506b1521e168a6fd7fb15e07e4eb950393b4fa8
Author: Andy Wingo <address@hidden>
Date: Thu Nov 21 18:33:06 2013 +0100
Remove last use of SCM vm
* libguile/threads.h (scm_i_thread): Hold a struct scm_vm*, not a SCM
vm.
* libguile/threads.c (guilify_self_2):
* libguile/vm.c (make_vm): Adapt.
commit e7f9ababe0532c9b086ffa6b3825d0dafc9364bc
Author: Andy Wingo <address@hidden>
Date: Thu Nov 21 18:28:06 2013 +0100
scm_the_vm now returns raw struct scm_vm pointer
* libguile/vm.h (scm_the_vm): Return struct scm_vm*.
(scm_c_vm_run): Remove.
* libguile/control.c:
* libguile/eval.c:
* libguile/throw.c:
* libguile/vm.c: Adapt.
commit 55ee3607003702ef5c53994c6216b9f0f835e0f1
Author: Andy Wingo <address@hidden>
Date: Thu Nov 21 18:23:08 2013 +0100
Prefer scm_call_n to scm_c_vm_run (scm_the_vm())
* libguile/vm.c (scm_i_capture_current_stack): Cosmetic tweak.
(scm_call_n): Define here instead of in eval.c. All callers of
scm_c_vm_run were passing scm_the_vm() as the VM. Eventually
scm_call_n will replace scm_c_vm_run.
* libguile/eval.c: Adapt all callers.
commit 4fcbc1b0d8207df2dafce5fa80b942366d0ed7ed
Author: Andy Wingo <address@hidden>
Date: Thu Nov 21 18:09:29 2013 +0100
scm_i_prompt_pop_abort_args_x takes struct scm_vm* as arg
* libguile/control.h:
* libguile/control.c (scm_i_prompt_pop_abort_args_x): Change to take VP
as an arg, not VM.
* libguile/eval.c (eval):
* libguile/throw.c (pre_init_catch): Adapt.
-----------------------------------------------------------------------
Summary of changes:
libguile/control.c | 10 ++--
libguile/control.h | 2 +-
libguile/eval.c | 60 +++++++++++------------
libguile/evalext.c | 1 -
libguile/gc.c | 2 -
libguile/goops.c | 5 --
libguile/print.c | 3 -
libguile/tags.h | 2 +-
libguile/threads.c | 2 +-
libguile/threads.h | 2 +-
libguile/throw.c | 16 ++++--
libguile/vm-engine.c | 78 +++++------------------------
libguile/vm.c | 133 +++++++++++++++++++++++++++++---------------------
libguile/vm.h | 14 +-----
14 files changed, 140 insertions(+), 190 deletions(-)
diff --git a/libguile/control.c b/libguile/control.c
index 4f7cc78..347d697 100644
--- a/libguile/control.c
+++ b/libguile/control.c
@@ -39,18 +39,18 @@
/* Only to be called if the SCM_I_SETJMP returns 1 */
SCM
-scm_i_prompt_pop_abort_args_x (SCM vm)
+scm_i_prompt_pop_abort_args_x (struct scm_vm *vp)
{
size_t i, n;
SCM vals = SCM_EOL;
- n = scm_to_size_t (SCM_VM_DATA (vm)->sp[0]);
+ n = scm_to_size_t (vp->sp[0]);
for (i = 0; i < n; i++)
- vals = scm_cons (SCM_VM_DATA (vm)->sp[-(i + 1)], vals);
+ vals = scm_cons (vp->sp[-(i + 1)], vals);
/* The abort did reset the VM's registers, but then these values
were pushed on; so we need to pop them ourselves. */
- SCM_VM_DATA (vm)->sp -= n + 1;
+ vp->sp -= n + 1;
/* FIXME NULLSTACK */
return vals;
@@ -198,7 +198,7 @@ SCM_DEFINE (scm_abort_to_prompt_star, "abort-to-prompt*",
2, 0, 0,
for (i = 0; i < n; i++, args = scm_cdr (args))
argv[i] = scm_car (args);
- scm_c_abort (SCM_VM_DATA (scm_the_vm ()), tag, n, argv, NULL);
+ scm_c_abort (scm_the_vm (), tag, n, argv, NULL);
/* Oh, what, you're still here? The abort must have been reinstated.
Actually,
that's quite impossible, given that we're already in C-land here, so...
diff --git a/libguile/control.h b/libguile/control.h
index b9a7e23..4b76591 100644
--- a/libguile/control.h
+++ b/libguile/control.h
@@ -22,7 +22,7 @@
#include "libguile/vm.h"
-SCM_INTERNAL SCM scm_i_prompt_pop_abort_args_x (SCM vm);
+SCM_INTERNAL SCM scm_i_prompt_pop_abort_args_x (struct scm_vm *vp);
SCM_INTERNAL void scm_c_abort (struct scm_vm *vp, SCM tag, size_t n, SCM *argv,
scm_i_jmp_buf *registers) SCM_NORETURN;
diff --git a/libguile/eval.c b/libguile/eval.c
index 7b09d84..3e828a1 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -334,7 +334,7 @@ eval (SCM x, SCM env)
for (i = 0; i < argc; i++, mx = CDR (mx))
argv[i] = EVAL1 (CAR (mx), env);
- return scm_c_vm_run (scm_the_vm (), proc, argv, argc);
+ return scm_call_n (proc, argv, argc);
}
case SCM_M_CONT:
@@ -438,7 +438,8 @@ eval (SCM x, SCM env)
case SCM_M_CALL_WITH_PROMPT:
{
- SCM vm, k, res;
+ struct scm_vm *vp;
+ SCM k, res;
scm_i_jmp_buf registers;
/* We need the handler after nonlocal return to the setjmp, so
make sure it is volatile. */
@@ -446,23 +447,24 @@ eval (SCM x, SCM env)
k = EVAL1 (CAR (mx), env);
handler = EVAL1 (CDDR (mx), env);
- vm = scm_the_vm ();
+ vp = scm_the_vm ();
/* Push the prompt onto the dynamic stack. */
- scm_dynstack_push_prompt
- (&SCM_I_CURRENT_THREAD->dynstack,
- SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY |
SCM_F_DYNSTACK_PROMPT_PUSH_NARGS,
- k,
- SCM_VM_DATA (vm)->fp - SCM_VM_DATA (vm)->stack_base,
- SCM_VM_DATA (vm)->sp - SCM_VM_DATA (vm)->stack_base,
- SCM_VM_DATA (vm)->ip,
- ®isters);
+ scm_dynstack_push_prompt (&SCM_I_CURRENT_THREAD->dynstack,
+ SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY
+ | SCM_F_DYNSTACK_PROMPT_PUSH_NARGS,
+ k,
+ vp->fp - vp->stack_base,
+ vp->sp - vp->stack_base,
+ vp->ip,
+ ®isters);
if (SCM_I_SETJMP (registers))
{
/* The prompt exited nonlocally. */
proc = handler;
- args = scm_i_prompt_pop_abort_args_x (scm_the_vm ());
+ vp = scm_the_vm ();
+ args = scm_i_prompt_pop_abort_args_x (vp);
goto apply_proc;
}
@@ -484,41 +486,41 @@ eval (SCM x, SCM env)
SCM
scm_call_0 (SCM proc)
{
- return scm_c_vm_run (scm_the_vm (), proc, NULL, 0);
+ return scm_call_n (proc, NULL, 0);
}
SCM
scm_call_1 (SCM proc, SCM arg1)
{
- return scm_c_vm_run (scm_the_vm (), proc, &arg1, 1);
+ return scm_call_n (proc, &arg1, 1);
}
SCM
scm_call_2 (SCM proc, SCM arg1, SCM arg2)
{
SCM args[] = { arg1, arg2 };
- return scm_c_vm_run (scm_the_vm (), proc, args, 2);
+ return scm_call_n (proc, args, 2);
}
SCM
scm_call_3 (SCM proc, SCM arg1, SCM arg2, SCM arg3)
{
SCM args[] = { arg1, arg2, arg3 };
- return scm_c_vm_run (scm_the_vm (), proc, args, 3);
+ return scm_call_n (proc, args, 3);
}
SCM
scm_call_4 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4)
{
SCM args[] = { arg1, arg2, arg3, arg4 };
- return scm_c_vm_run (scm_the_vm (), proc, args, 4);
+ return scm_call_n (proc, args, 4);
}
SCM
scm_call_5 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4, SCM arg5)
{
SCM args[] = { arg1, arg2, arg3, arg4, arg5 };
- return scm_c_vm_run (scm_the_vm (), proc, args, 5);
+ return scm_call_n (proc, args, 5);
}
SCM
@@ -526,7 +528,7 @@ scm_call_6 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM
arg4, SCM arg5,
SCM arg6)
{
SCM args[] = { arg1, arg2, arg3, arg4, arg5, arg6 };
- return scm_c_vm_run (scm_the_vm (), proc, args, 6);
+ return scm_call_n (proc, args, 6);
}
SCM
@@ -534,7 +536,7 @@ scm_call_7 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM
arg4, SCM arg5,
SCM arg6, SCM arg7)
{
SCM args[] = { arg1, arg2, arg3, arg4, arg5, arg6, arg7 };
- return scm_c_vm_run (scm_the_vm (), proc, args, 7);
+ return scm_call_n (proc, args, 7);
}
SCM
@@ -542,7 +544,7 @@ scm_call_8 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM
arg4, SCM arg5,
SCM arg6, SCM arg7, SCM arg8)
{
SCM args[] = { arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8 };
- return scm_c_vm_run (scm_the_vm (), proc, args, 8);
+ return scm_call_n (proc, args, 8);
}
SCM
@@ -550,14 +552,10 @@ scm_call_9 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM
arg4, SCM arg5,
SCM arg6, SCM arg7, SCM arg8, SCM arg9)
{
SCM args[] = { arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9 };
- return scm_c_vm_run (scm_the_vm (), proc, args, 9);
+ return scm_call_n (proc, args, 9);
}
-SCM
-scm_call_n (SCM proc, SCM *argv, size_t nargs)
-{
- return scm_c_vm_run (scm_the_vm (), proc, argv, nargs);
-}
+/* scm_call_n defined in vm.c */
SCM
scm_call (SCM proc, ...)
@@ -577,7 +575,7 @@ scm_call (SCM proc, ...)
argv[i] = va_arg (argp, SCM);
va_end (argp);
- return scm_c_vm_run (scm_the_vm (), proc, argv, nargs);
+ return scm_call_n (proc, argv, nargs);
}
/* Simple procedure applies
@@ -601,7 +599,7 @@ scm_apply_0 (SCM proc, SCM args)
args = SCM_CDR (args);
}
- return scm_c_vm_run (scm_the_vm (), proc, argv, nargs);
+ return scm_call_n (proc, argv, nargs);
}
SCM
@@ -662,8 +660,8 @@ static SCM var_primitive_eval;
SCM
scm_primitive_eval (SCM exp)
{
- return scm_c_vm_run (scm_the_vm (), scm_variable_ref (var_primitive_eval),
- &exp, 1);
+ return scm_call_n (scm_variable_ref (var_primitive_eval),
+ &exp, 1);
}
diff --git a/libguile/evalext.c b/libguile/evalext.c
index d80dee7..48a9eff 100644
--- a/libguile/evalext.c
+++ b/libguile/evalext.c
@@ -81,7 +81,6 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0,
0,
case scm_tc7_fluid:
case scm_tc7_dynamic_state:
case scm_tc7_frame:
- case scm_tc7_vm:
case scm_tc7_vm_cont:
case scm_tc7_number:
case scm_tc7_string:
diff --git a/libguile/gc.c b/libguile/gc.c
index dfec8d5..927b170 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -944,8 +944,6 @@ scm_i_tag_name (scm_t_bits tag)
return "dynamic state";
case scm_tc7_frame:
return "frame";
- case scm_tc7_vm:
- return "vm";
case scm_tc7_vm_cont:
return "vm continuation";
case scm_tc7_wvect:
diff --git a/libguile/goops.c b/libguile/goops.c
index ca1c157..013a65c 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -155,7 +155,6 @@ static SCM class_hashtable;
static SCM class_fluid;
static SCM class_dynamic_state;
static SCM class_frame;
-static SCM class_vm;
static SCM class_vm_cont;
static SCM class_bytevector;
static SCM class_uvec;
@@ -265,8 +264,6 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
return class_dynamic_state;
case scm_tc7_frame:
return class_frame;
- case scm_tc7_vm:
- return class_vm;
case scm_tc7_vm_cont:
return class_vm_cont;
case scm_tc7_bytevector:
@@ -2512,8 +2509,6 @@ create_standard_classes (void)
scm_class_class, scm_class_top, SCM_EOL);
make_stdcls (&class_frame, "<frame>",
scm_class_class, scm_class_top, SCM_EOL);
- make_stdcls (&class_vm, "<vm>",
- scm_class_class, scm_class_top, SCM_EOL);
make_stdcls (&class_vm_cont, "<vm-continuation>",
scm_class_class, scm_class_top, SCM_EOL);
make_stdcls (&class_bytevector, "<bytevector>",
diff --git a/libguile/print.c b/libguile/print.c
index 4809fd6..a8f220b 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -684,9 +684,6 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
case scm_tc7_frame:
scm_i_frame_print (exp, port, pstate);
break;
- case scm_tc7_vm:
- scm_i_vm_print (exp, port, pstate);
- break;
case scm_tc7_vm_cont:
scm_i_vm_cont_print (exp, port, pstate);
break;
diff --git a/libguile/tags.h b/libguile/tags.h
index 598b048..4a1b192 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -424,7 +424,7 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
#define scm_tc7_frame 47
#define scm_tc7_unused_53 53
-#define scm_tc7_vm 55
+#define scm_tc7_unused_55 55
#define scm_tc7_vm_cont 71
#define scm_tc7_unused_17 61
diff --git a/libguile/threads.c b/libguile/threads.c
index 99582cc..994cf2c 100644
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -614,7 +614,7 @@ guilify_self_2 (SCM parent)
t->continuation_root = scm_cons (t->handle, SCM_EOL);
t->continuation_base = t->base;
- t->vm = SCM_BOOL_F;
+ t->vp = NULL;
if (scm_is_true (parent))
t->dynamic_state = scm_make_dynamic_state (parent);
diff --git a/libguile/threads.h b/libguile/threads.h
index 147e36d..3b67aac 100644
--- a/libguile/threads.h
+++ b/libguile/threads.h
@@ -110,7 +110,7 @@ typedef struct scm_i_thread {
SCM_STACKITEM *continuation_base;
/* For keeping track of the stack and registers. */
- SCM vm;
+ struct scm_vm *vp;
SCM_STACKITEM *base;
scm_i_jmp_buf regs;
#ifdef __ia64__
diff --git a/libguile/throw.c b/libguile/throw.c
index e68f428..4b1885e 100644
--- a/libguile/throw.c
+++ b/libguile/throw.c
@@ -456,7 +456,8 @@ SCM_SYMBOL (sym_pre_init_catch_tag, "%pre-init-catch-tag");
static SCM
pre_init_catch (SCM tag, SCM thunk, SCM handler, SCM pre_unwind_handler)
{
- volatile SCM vm, v_handler;
+ struct scm_vm *vp;
+ volatile SCM v_handler;
SCM res;
scm_t_dynstack *dynstack = &SCM_I_CURRENT_THREAD->dynstack;
scm_i_jmp_buf registers;
@@ -469,7 +470,7 @@ pre_init_catch (SCM tag, SCM thunk, SCM handler, SCM
pre_unwind_handler)
/* These two are volatile, so we know we can access them after a
nonlocal return to the setjmp. */
- vm = scm_the_vm ();
+ vp = scm_the_vm ();
v_handler = handler;
/* Push the prompt onto the dynamic stack. */
@@ -477,15 +478,18 @@ pre_init_catch (SCM tag, SCM thunk, SCM handler, SCM
pre_unwind_handler)
SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY
| SCM_F_DYNSTACK_PROMPT_PUSH_NARGS,
sym_pre_init_catch_tag,
- SCM_VM_DATA (vm)->fp - SCM_VM_DATA
(vm)->stack_base,
- SCM_VM_DATA (vm)->sp - SCM_VM_DATA
(vm)->stack_base,
- SCM_VM_DATA (vm)->ip,
+ vp->fp - vp->stack_base,
+ vp->sp - vp->stack_base,
+ vp->ip,
®isters);
if (SCM_I_SETJMP (registers))
{
/* nonlocal exit */
- SCM args = scm_i_prompt_pop_abort_args_x (vm);
+ SCM args;
+ /* vp is not volatile */
+ vp = scm_the_vm ();
+ args = scm_i_prompt_pop_abort_args_x (vp);
/* cdr past the continuation */
return scm_apply_0 (v_handler, scm_cdr (args));
}
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index b507511..4e1d4f8 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -214,7 +214,7 @@
#define CACHE_REGISTER() \
do { \
- ip = (scm_t_uint32 *) vp->ip; \
+ ip = vp->ip; \
fp = vp->fp; \
} while (0)
@@ -424,7 +424,8 @@
((scm_t_uintptr) (ptr) % alignof_type (type) == 0)
static SCM
-VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, size_t nargs_)
+VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
+ scm_i_jmp_buf *registers, int resume)
{
/* Instruction pointer: A pointer to the opcode that is currently
running. */
@@ -438,10 +439,6 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, size_t
nargs_)
/* Current opcode: A cache of *ip. */
register scm_t_uint32 op;
- /* Cached variables. */
- scm_i_thread *current_thread = SCM_I_CURRENT_THREAD;
- scm_i_jmp_buf registers; /* used for prompts */
-
#ifdef HAVE_LABELS_AS_VALUES
static const void **jump_table_pointer = NULL;
register const void **jump_table JT_REG;
@@ -462,64 +459,17 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv,
size_t nargs_)
jump_table = jump_table_pointer;
#endif
- if (SCM_I_SETJMP (registers))
- {
- /* Non-local return. The values are on the stack, on a new frame
- set up to call `values' to return the values to the handler.
- Cache the VM registers back from the vp, and dispatch to the
- body of `values'.
-
- Note, at this point, we must assume that any variable local to
- vm_engine that can be assigned *has* been assigned. So we need
- to pull all our state back from the ip/fp/sp.
- */
- CACHE_REGISTER ();
- ABORT_CONTINUATION_HOOK ();
- NEXT (0);
- }
-
- /* Load previous VM registers. */
+ /* Load VM registers. */
CACHE_REGISTER ();
VM_HANDLE_INTERRUPTS;
- /* Initialization */
- {
- SCM *base;
- ptrdiff_t base_frame_size;
-
- /* Check that we have enough space: 3 words for the boot
- continuation, 3 + nargs for the procedure application, and 3 for
- setting up a new frame. */
- base_frame_size = 3 + 3 + nargs_ + 3;
- vp->sp += base_frame_size;
- CHECK_OVERFLOW ();
- base = vp->sp + 1 - base_frame_size;
-
- /* Since it's possible to receive the arguments on the stack itself,
- and indeed the regular VM invokes us that way, shuffle up the
- arguments first. */
- {
- int i;
- for (i = nargs_ - 1; i >= 0; i--)
- base[6 + i] = argv[i];
- }
-
- /* Initial frame, saving previous fp and ip, with the boot
- continuation. */
- base[0] = SCM_PACK (fp); /* dynamic link */
- base[1] = SCM_PACK (ip); /* ra */
- base[2] = vm_boot_continuation;
- fp = &base[2];
- ip = (scm_t_uint32 *) vm_boot_continuation_code;
-
- /* MV-call frame, function & arguments */
- base[3] = SCM_PACK (fp); /* dynamic link */
- base[4] = SCM_PACK (ip); /* ra */
- base[5] = program;
- fp = vp->fp = &base[5];
- RESET_FRAME (nargs_ + 1);
- }
+ /* Usually a call to the VM happens on application, with the boot
+ continuation on the next frame. Sometimes it happens after a
+ non-local exit however; in that case the VM state is all set up,
+ and we have but to jump to the next opcode. */
+ if (SCM_UNLIKELY (resume))
+ NEXT (0);
apply:
while (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp)))
@@ -925,7 +875,7 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, size_t
nargs_)
vm_reinstate_partial_continuation (vp, vmcont, FRAME_LOCALS_COUNT_FROM
(1),
LOCAL_ADDRESS (1),
¤t_thread->dynstack,
- ®isters);
+ registers);
CACHE_REGISTER ();
NEXT (0);
}
@@ -1043,7 +993,7 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, size_t
nargs_)
ip++;
SYNC_IP ();
vm_abort (vp, LOCAL_REF (1), nlocals - 2, LOCAL_ADDRESS (2),
- SCM_EOL, LOCAL_ADDRESS (0), ®isters);
+ SCM_EOL, LOCAL_ADDRESS (0), registers);
/* vm_abort should not return */
abort ();
@@ -2052,7 +2002,7 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv,
size_t nargs_)
fp - vp->stack_base,
LOCAL_ADDRESS (proc_slot) - vp->stack_base,
ip + offset,
- ®isters);
+ registers);
NEXT (3);
}
@@ -2141,7 +2091,7 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv,
size_t nargs_)
if (scm_is_eq (val, SCM_UNDEFINED))
val = SCM_I_FLUID_DEFAULT (fluid);
VM_ASSERT (!scm_is_eq (val, SCM_UNDEFINED),
- vm_error_unbound_fluid (program, fluid));
+ vm_error_unbound_fluid (SCM_FRAME_PROGRAM (fp), fluid));
LOCAL_SET (dst, val);
}
diff --git a/libguile/vm.c b/libguile/vm.c
index c761872..3c28c17 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -150,16 +150,15 @@ vm_return_to_continuation (struct scm_vm *vp, SCM cont,
size_t n, SCM *argv)
}
}
+static struct scm_vm * thread_vm (scm_i_thread *t);
SCM
scm_i_capture_current_stack (void)
{
scm_i_thread *thread;
- SCM vm;
struct scm_vm *vp;
thread = SCM_I_CURRENT_THREAD;
- vm = scm_the_vm ();
- vp = SCM_VM_DATA (vm);
+ vp = thread_vm (thread);
return scm_i_vm_capture_stack (vp->stack_base, vp->fp, vp->sp, vp->ip,
scm_dynstack_capture_all (&thread->dynstack),
@@ -369,36 +368,6 @@ vm_reinstate_partial_continuation (struct scm_vm *vp, SCM
cont,
/*
- * VM Internal functions
- */
-
-void
-scm_i_vm_print (SCM x, SCM port, scm_print_state *pstate)
-{
- const struct scm_vm *vm;
-
- vm = SCM_VM_DATA (x);
-
- scm_puts_unlocked ("#<vm ", port);
- switch (vm->engine)
- {
- case SCM_VM_REGULAR_ENGINE:
- scm_puts_unlocked ("regular-engine ", port);
- break;
-
- case SCM_VM_DEBUG_ENGINE:
- scm_puts_unlocked ("debug-engine ", port);
- break;
-
- default:
- scm_puts_unlocked ("unknown-engine ", port);
- }
- scm_uintprint (SCM_UNPACK (x), 16, port);
- scm_puts_unlocked (">", port);
-}
-
-
-/*
* VM Error Handling
*/
@@ -737,8 +706,8 @@ initialize_default_stack_size (void)
#undef VM_USE_HOOKS
#undef VM_NAME
-typedef SCM (*scm_t_vm_engine) (struct scm_vm *vp,
- SCM program, SCM *argv, size_t nargs);
+typedef SCM (*scm_t_vm_engine) (scm_i_thread *current_thread, struct scm_vm
*vp,
+ scm_i_jmp_buf *registers, int resume);
static const scm_t_vm_engine vm_engines[SCM_VM_NUM_ENGINES] =
{ vm_regular_engine, vm_debug_engine };
@@ -750,7 +719,7 @@ static int vm_stack_gc_kind;
#endif
-static SCM
+static struct scm_vm *
make_vm (void)
#define FUNC_NAME "make_vm"
{
@@ -783,7 +752,8 @@ make_vm (void)
vp->trace_level = 0;
for (i = 0; i < SCM_VM_NUM_HOOKS; i++)
vp->hooks[i] = SCM_BOOL_F;
- return scm_cell (scm_tc7_vm, (scm_t_bits)vp);
+
+ return vp;
}
#undef FUNC_NAME
@@ -818,23 +788,75 @@ vm_stack_mark (GC_word *addr, struct GC_ms_entry
*mark_stack_ptr,
#endif /* VM_ENABLE_PRECISE_STACK_GC_SCAN */
-SCM
-scm_c_vm_run (SCM vm, SCM program, SCM *argv, int nargs)
+static struct scm_vm *
+thread_vm (scm_i_thread *t)
{
- struct scm_vm *vp = SCM_VM_DATA (vm);
- SCM_CHECK_STACK;
- return vm_engines[vp->engine](vp, program, argv, nargs);
+ if (SCM_UNLIKELY (!t->vp))
+ t->vp = make_vm ();
+
+ return t->vp;
}
-SCM
+struct scm_vm *
scm_the_vm (void)
{
- scm_i_thread *t = SCM_I_CURRENT_THREAD;
+ return thread_vm (SCM_I_CURRENT_THREAD);
+}
- if (SCM_UNLIKELY (scm_is_false (t->vm)))
- t->vm = make_vm ();
+SCM
+scm_call_n (SCM proc, SCM *argv, size_t nargs)
+{
+ scm_i_thread *thread;
+ struct scm_vm *vp;
+ SCM *base;
+ ptrdiff_t base_frame_size;
+ /* Cached variables. */
+ scm_i_jmp_buf registers; /* used for prompts */
+ size_t i;
- return t->vm;
+ thread = SCM_I_CURRENT_THREAD;
+ vp = thread_vm (thread);
+
+ SCM_CHECK_STACK;
+
+ /* Check that we have enough space: 3 words for the boot
+ continuation, 3 + nargs for the procedure application, and 3 for
+ setting up a new frame. */
+ base_frame_size = 3 + 3 + nargs + 3;
+ vp->sp += base_frame_size;
+ if (vp->sp >= vp->stack_limit)
+ vm_error_stack_overflow (vp);
+ base = vp->sp + 1 - base_frame_size;
+
+ /* Since it's possible to receive the arguments on the stack itself,
+ shuffle up the arguments first. */
+ for (i = nargs; i > 0; i--)
+ base[6 + i - 1] = argv[i - 1];
+
+ /* Push the boot continuation, which calls PROC and returns its
+ result(s). */
+ base[0] = SCM_PACK (vp->fp); /* dynamic link */
+ base[1] = SCM_PACK (vp->ip); /* ra */
+ base[2] = vm_boot_continuation;
+ vp->fp = &base[2];
+ vp->ip = (scm_t_uint32 *) vm_boot_continuation_code;
+
+ /* The pending call to PROC. */
+ base[3] = SCM_PACK (vp->fp); /* dynamic link */
+ base[4] = SCM_PACK (vp->ip); /* ra */
+ base[5] = proc;
+ vp->fp = &base[5];
+ vp->sp = &SCM_FRAME_LOCAL (vp->fp, nargs);
+
+ {
+ int resume = SCM_I_SETJMP (registers);
+
+ if (SCM_UNLIKELY (resume))
+ /* Non-local return. */
+ vm_dispatch_abort_hook (vp);
+
+ return vm_engines[vp->engine](thread, vp, ®isters, resume);
+ }
}
/* Scheme interface */
@@ -842,7 +864,7 @@ scm_the_vm (void)
#define VM_DEFINE_HOOK(n) \
{ \
struct scm_vm *vp; \
- vp = SCM_VM_DATA (scm_the_vm ()); \
+ vp = scm_the_vm (); \
if (scm_is_false (vp->hooks[n])) \
vp->hooks[n] = scm_make_hook (SCM_I_MAKINUM (1)); \
return vp->hooks[n]; \
@@ -907,7 +929,7 @@ SCM_DEFINE (scm_vm_trace_level, "vm-trace-level", 0, 0, 0,
"")
#define FUNC_NAME s_scm_vm_trace_level
{
- return scm_from_int (SCM_VM_DATA (scm_the_vm ())->trace_level);
+ return scm_from_int (scm_the_vm ()->trace_level);
}
#undef FUNC_NAME
@@ -916,7 +938,7 @@ SCM_DEFINE (scm_set_vm_trace_level_x,
"set-vm-trace-level!", 1, 0, 0,
"")
#define FUNC_NAME s_scm_set_vm_trace_level_x
{
- SCM_VM_DATA (scm_the_vm ())->trace_level = scm_to_int (level);
+ scm_the_vm ()->trace_level = scm_to_int (level);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
@@ -958,7 +980,7 @@ SCM_DEFINE (scm_vm_engine, "vm-engine", 0, 0, 0,
"")
#define FUNC_NAME s_scm_vm_engine
{
- return vm_engine_to_symbol (SCM_VM_DATA (scm_the_vm ())->engine, FUNC_NAME);
+ return vm_engine_to_symbol (scm_the_vm ()->engine, FUNC_NAME);
}
#undef FUNC_NAME
@@ -970,7 +992,7 @@ scm_c_set_vm_engine_x (int engine)
SCM_MISC_ERROR ("Unknown VM engine: ~a",
scm_list_1 (scm_from_int (engine)));
- SCM_VM_DATA (scm_the_vm ())->engine = engine;
+ scm_the_vm ()->engine = engine;
}
#undef FUNC_NAME
@@ -1023,11 +1045,10 @@ SCM_DEFINE (scm_call_with_vm, "call-with-vm", 1, 0, 1,
* Initialize
*/
-SCM scm_load_compiled_with_vm (SCM file)
+SCM
+scm_load_compiled_with_vm (SCM file)
{
- SCM program = scm_load_thunk_from_file (file);
-
- return scm_c_vm_run (scm_the_vm (), program, NULL, 0);
+ return scm_call_0 (scm_load_thunk_from_file (file));
}
diff --git a/libguile/vm.h b/libguile/vm.h
index 0b1a941..12481e1 100644
--- a/libguile/vm.h
+++ b/libguile/vm.h
@@ -32,8 +32,6 @@ enum {
SCM_VM_NUM_HOOKS,
};
-struct scm_vm;
-
#define SCM_VM_REGULAR_ENGINE 0
#define SCM_VM_DEBUG_ENGINE 1
#define SCM_VM_NUM_ENGINES 2
@@ -50,13 +48,7 @@ struct scm_vm {
int engine; /* which vm engine we're using */
};
-SCM_API SCM scm_the_vm_fluid;
-
-#define SCM_VM_P(x) (SCM_HAS_TYP7 (x, scm_tc7_vm))
-#define SCM_VM_DATA(vm) ((struct scm_vm *) SCM_CELL_WORD_1 (vm))
-#define SCM_VALIDATE_VM(pos,x) SCM_MAKE_VALIDATE (pos, x, VM_P)
-
-SCM_API SCM scm_the_vm (void);
+SCM_INTERNAL struct scm_vm *scm_the_vm (void);
SCM_API SCM scm_call_with_vm (SCM proc, SCM args);
SCM_API SCM scm_vm_apply_hook (void);
@@ -94,10 +86,6 @@ struct scm_vm_cont {
SCM_API SCM scm_load_compiled_with_vm (SCM file);
-SCM_INTERNAL SCM scm_c_vm_run (SCM vm, SCM program, SCM *argv, int nargs);
-
-SCM_INTERNAL void scm_i_vm_print (SCM x, SCM port,
- scm_print_state *pstate);
SCM_INTERNAL SCM scm_i_call_with_current_continuation (SCM proc);
SCM_INTERNAL SCM scm_i_capture_current_stack (void);
SCM_INTERNAL SCM scm_i_vm_capture_stack (SCM *stack_base, SCM *fp, SCM *sp,
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. v2.1.0-448-gdd1c7de,
Andy Wingo <=