mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-07-02 15:40:38 +02:00
Give continuations (contregs) their own static tc16
* libguile/continuations-internal.h: New file, for internal definitions. * libguile/continuations.h: Move out internal definitions. * libguile/Makefile.am: Add new file. * libguile/continuations.c: Adapt to put the tag in the beginning of the continuation (contregs) structure. * libguile/eq.c: * libguile/goops.c: * libguile/init.c: * libguile/print.c: * libguile/scm.h: * libguile/stacks.c: * libguile/vm.c: * module/oop/goops.scm: Adapt to contregs tc16 change.
This commit is contained in:
Andy Wingo
parent
f47fe6e752
commit
12da6739b1
12 changed files with 156 additions and 133 deletions
|
|
@ -53,23 +53,9 @@
|
|||
#include "symbols.h"
|
||||
#include "vm.h"
|
||||
|
||||
#include "continuations.h"
|
||||
#include "continuations-internal.h"
|
||||
|
||||
|
||||
|
||||
|
||||
static scm_t_bits tc16_continuation;
|
||||
#define SCM_CONTREGSP(x) SCM_TYP16_PREDICATE (tc16_continuation, x)
|
||||
|
||||
#define SCM_CONTREGS(x) ((scm_t_contregs *) SCM_SMOB_DATA_1 (x))
|
||||
|
||||
#define SCM_CONTINUATION_LENGTH(x) (SCM_CONTREGS (x)->num_stack_items)
|
||||
#define SCM_SET_CONTINUATION_LENGTH(x, n)\
|
||||
(SCM_CONTREGS (x)->num_stack_items = (n))
|
||||
#define SCM_JMPBUF(x) ((SCM_CONTREGS (x))->jmpbuf)
|
||||
#define SCM_CONTINUATION_ROOT(x) ((SCM_CONTREGS (x))->root)
|
||||
#define SCM_DFRAME(x) ((SCM_CONTREGS (x))->dframe)
|
||||
|
||||
|
||||
|
||||
/* scm_i_make_continuation will return a procedure whose code will
|
||||
|
|
@ -98,7 +84,7 @@ struct goto_continuation_code goto_continuation_code = {
|
|||
};
|
||||
|
||||
static SCM
|
||||
make_continuation_trampoline (SCM contregs)
|
||||
make_continuation_trampoline (struct scm_continuation *cont)
|
||||
{
|
||||
scm_t_bits nfree = 1;
|
||||
scm_t_bits flags = SCM_F_PROGRAM_IS_CONTINUATION;
|
||||
|
|
@ -109,7 +95,7 @@ make_continuation_trampoline (SCM contregs)
|
|||
"foreign procedure");
|
||||
ret->tag_flags_and_free_variable_count = tag;
|
||||
ret->code = goto_continuation_code.code;
|
||||
ret->free_variables[0] = contregs;
|
||||
ret->free_variables[0] = scm_from_continuation (cont);
|
||||
|
||||
return scm_from_program (ret);
|
||||
}
|
||||
|
|
@ -119,10 +105,10 @@ make_continuation_trampoline (SCM contregs)
|
|||
*/
|
||||
|
||||
|
||||
static int
|
||||
continuation_print (SCM obj, SCM port, scm_print_state *state SCM_UNUSED)
|
||||
int
|
||||
scm_i_print_continuation (SCM obj, SCM port, scm_print_state *state SCM_UNUSED)
|
||||
{
|
||||
scm_t_contregs *continuation = SCM_CONTREGS (obj);
|
||||
struct scm_continuation *continuation = scm_to_continuation (obj);
|
||||
|
||||
scm_puts ("#<continuation ", port);
|
||||
scm_intprint (continuation->num_stack_items, 10, port);
|
||||
|
|
@ -144,7 +130,7 @@ continuation_print (SCM obj, SCM port, scm_print_state *state SCM_UNUSED)
|
|||
#endif
|
||||
|
||||
static void
|
||||
capture_auxiliary_stack (scm_thread *thread, scm_t_contregs *continuation)
|
||||
capture_auxiliary_stack (scm_thread *thread, struct scm_continuation *continuation)
|
||||
{
|
||||
#if SCM_HAVE_AUXILIARY_STACK
|
||||
# if !defined __ia64 || !defined __ia64__
|
||||
|
|
@ -178,7 +164,7 @@ capture_auxiliary_stack (scm_thread *thread, scm_t_contregs *continuation)
|
|||
}
|
||||
|
||||
static void
|
||||
restore_auxiliary_stack (scm_thread *thread, scm_t_contregs *continuation)
|
||||
restore_auxiliary_stack (scm_thread *thread, struct scm_continuation *continuation)
|
||||
{
|
||||
#if SCM_HAVE_AUXILIARY_STACK
|
||||
memcpy (thread->auxiliary_stack_base, continuation->auxiliary_stack,
|
||||
|
|
@ -189,42 +175,37 @@ restore_auxiliary_stack (scm_thread *thread, scm_t_contregs *continuation)
|
|||
SCM
|
||||
scm_i_make_continuation (scm_thread *thread, struct scm_vm_cont *vm_cont)
|
||||
{
|
||||
SCM cont;
|
||||
scm_t_contregs *continuation;
|
||||
long stack_size;
|
||||
SCM_STACKITEM * src;
|
||||
|
||||
SCM_FLUSH_REGISTER_WINDOWS;
|
||||
stack_size = scm_stack_size (thread->continuation_base);
|
||||
continuation = scm_gc_malloc (sizeof (scm_t_contregs)
|
||||
+ (stack_size - 1) * sizeof (SCM_STACKITEM),
|
||||
"continuation");
|
||||
continuation->num_stack_items = stack_size;
|
||||
long stack_size = scm_stack_size (thread->continuation_base);
|
||||
struct scm_continuation *continuation =
|
||||
scm_gc_malloc (sizeof (struct scm_continuation)
|
||||
+ stack_size * sizeof (SCM_STACKITEM),
|
||||
"continuation");
|
||||
continuation->tag = scm_tc16_continuation;
|
||||
memcpy (continuation->jmpbuf, thread->vm.registers, sizeof (jmp_buf));
|
||||
capture_auxiliary_stack (thread, continuation);
|
||||
continuation->root = thread->continuation_root;
|
||||
src = thread->continuation_base;
|
||||
continuation->vm_cont = vm_cont;
|
||||
SCM_STACKITEM * src = thread->continuation_base;
|
||||
#if ! SCM_STACK_GROWS_UP
|
||||
src -= stack_size;
|
||||
#endif
|
||||
continuation->offset = continuation->stack - src;
|
||||
memcpy (continuation->stack, src, sizeof (SCM_STACKITEM) * stack_size);
|
||||
memcpy (continuation->jmpbuf, thread->vm.registers, sizeof (jmp_buf));
|
||||
continuation->vm_cont = vm_cont;
|
||||
capture_auxiliary_stack (thread, continuation);
|
||||
continuation->offset = continuation->stack - src;
|
||||
continuation->num_stack_items = stack_size;
|
||||
|
||||
SCM_NEWSMOB (cont, tc16_continuation, continuation);
|
||||
|
||||
return make_continuation_trampoline (cont);
|
||||
return make_continuation_trampoline (continuation);
|
||||
}
|
||||
|
||||
int
|
||||
scm_i_continuation_to_frame (SCM continuation, struct scm_frame *frame)
|
||||
{
|
||||
SCM contregs;
|
||||
scm_t_contregs *cont;
|
||||
struct scm_continuation *cont;
|
||||
|
||||
struct scm_program *program = scm_to_program (continuation);
|
||||
contregs = scm_program_free_variable_ref (program, 0);
|
||||
cont = SCM_CONTREGS (contregs);
|
||||
cont = scm_to_continuation (contregs);
|
||||
|
||||
if (cont->vm_cont)
|
||||
{
|
||||
|
|
@ -241,16 +222,6 @@ scm_i_continuation_to_frame (SCM continuation, struct scm_frame *frame)
|
|||
return 0;
|
||||
}
|
||||
|
||||
scm_t_contregs *
|
||||
scm_i_contregs (SCM contregs)
|
||||
{
|
||||
if (!SCM_CONTREGSP (contregs))
|
||||
abort ();
|
||||
|
||||
return SCM_CONTREGS (contregs);
|
||||
}
|
||||
|
||||
|
||||
/* {Apply}
|
||||
*/
|
||||
|
||||
|
|
@ -266,7 +237,7 @@ scm_i_contregs (SCM contregs)
|
|||
* with their correct stack.
|
||||
*/
|
||||
|
||||
static void scm_dynthrow (SCM, uint8_t *);
|
||||
static void scm_dynthrow (struct scm_continuation *, uint8_t *);
|
||||
|
||||
/* Grow the stack by a fixed amount to provide space to copy in the
|
||||
* continuation. Possibly this function has to be called several times
|
||||
|
|
@ -278,7 +249,7 @@ static void scm_dynthrow (SCM, uint8_t *);
|
|||
static scm_t_bits scm_i_dummy;
|
||||
|
||||
static void
|
||||
grow_stack (SCM cont, uint8_t *mra)
|
||||
grow_stack (struct scm_continuation *cont, uint8_t *mra)
|
||||
{
|
||||
scm_t_bits growth[100];
|
||||
|
||||
|
|
@ -293,7 +264,7 @@ grow_stack (SCM cont, uint8_t *mra)
|
|||
*/
|
||||
|
||||
static void
|
||||
copy_stack_and_call (scm_t_contregs *continuation,
|
||||
copy_stack_and_call (struct scm_continuation *continuation,
|
||||
SCM_STACKITEM * dst, uint8_t *mra)
|
||||
{
|
||||
scm_t_dynstack *dynstack;
|
||||
|
|
@ -319,10 +290,9 @@ copy_stack_and_call (scm_t_contregs *continuation,
|
|||
* actual copying and continuation calling.
|
||||
*/
|
||||
static void
|
||||
scm_dynthrow (SCM cont, uint8_t *mra)
|
||||
scm_dynthrow (struct scm_continuation *continuation, uint8_t *mra)
|
||||
{
|
||||
scm_thread *thread = SCM_I_CURRENT_THREAD;
|
||||
scm_t_contregs *continuation = SCM_CONTREGS (cont);
|
||||
SCM_STACKITEM *dst = thread->continuation_base;
|
||||
SCM_STACKITEM stack_top_element;
|
||||
|
||||
|
|
@ -332,7 +302,7 @@ scm_dynthrow (SCM cont, uint8_t *mra)
|
|||
#else
|
||||
dst -= continuation->num_stack_items;
|
||||
if (dst <= &stack_top_element)
|
||||
grow_stack (cont, mra);
|
||||
grow_stack (continuation, mra);
|
||||
#endif /* def SCM_STACK_GROWS_UP */
|
||||
|
||||
SCM_FLUSH_REGISTER_WINDOWS;
|
||||
|
|
@ -340,7 +310,7 @@ scm_dynthrow (SCM cont, uint8_t *mra)
|
|||
}
|
||||
|
||||
void
|
||||
scm_i_reinstate_continuation (SCM cont, uint8_t *mra)
|
||||
scm_i_reinstate_continuation (struct scm_continuation *cont, uint8_t *mra)
|
||||
{
|
||||
scm_dynthrow (cont, mra);
|
||||
abort (); /* Unreachable. */
|
||||
|
|
@ -521,7 +491,5 @@ SCM_DEFINE (scm_with_continuation_barrier, "with-continuation-barrier", 1,0,0,
|
|||
void
|
||||
scm_init_continuations ()
|
||||
{
|
||||
tc16_continuation = scm_make_smob_type ("continuation", 0);
|
||||
scm_set_smob_print (tc16_continuation, continuation_print);
|
||||
#include "continuations.x"
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue