diff options
Diffstat (limited to 'continue.c')
| -rw-r--r-- | continue.c | 255 |
1 files changed, 255 insertions, 0 deletions
diff --git a/continue.c b/continue.c new file mode 100644 index 0000000..b28fe6e --- /dev/null +++ b/continue.c @@ -0,0 +1,255 @@ +/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + */ + +/* "continue.c" Scheme Continuations for C. + Author: Aubrey Jaffer */ + +/* "setjump.h" contains definitions for the `other' field (type + CONTINUATION_OTHER) the struct Continuation. "setjump.h" must + #include "continue.h". CONTINUATION_OTHER defaults to `long' */ + +#define IN_CONTINUE_C +#ifdef USE_CONTINUE_H +# include "continue.h" +#else +# include "setjump.h" +#endif + +/* For platforms with short integers, we use thrown_value instead of + the value returned from setjmp so that any (long) value can be + returned. */ + +#ifdef SHORT_INT +long thrown_value; +#endif + +/* stack_size() returns the number of units of size STACKITEM which + fit between @var{start} and the current top of stack. No check is + done in this routine to ensure that @var{start} is actually in the + current stack segment. */ + +long stack_size(start) + STACKITEM *start; +{ + STACKITEM stack; +#ifdef STACK_GROWS_UP + return &stack - start; +#else + return start - &stack; +#endif /* def STACK_GROWS_UP */ +} + +/* make_root_continuation() allocates (malloc) storage for a + CONTINUATION near the current extent of stack. This newly + allocated CONTINUATION is returned if successful, 0 if not. After + make_root_continuation() returns, the calling routine still needs + to `setjmp(new_continuation->jmpbuf)' in order to complete the + capture of this continuation. */ + +CONTINUATION *make_root_continuation(stack_base) + STACKITEM *stack_base; +{ + CONTINUATION *cont; + cont = (CONTINUATION *)malloc(sizeof(CONTINUATION)); + if (!cont) return 0; + cont->length = 0; + cont->stkbse = stack_base; + cont->parent = cont; + return cont; +} + +/* make_continuation() allocates storage for the current continuation, + copying (or encapsulating) the stack state from parent_cont->stkbse + to the current top of stack. The newly allocated CONTINUATION is + returned if successful, 0 if not. After make_continuation() + returns, the calling routine still needs to + `setjmp(new_continuation->jmpbuf)' in order to complete the capture + of this continuation. */ + +/* Note: allocating local (stack) storage for the CONTINUATION would + not work; Think about it. */ + +CONTINUATION *make_continuation(parent_cont) + CONTINUATION *parent_cont; +{ + CONTINUATION *cont; +#ifdef CHEAP_CONTINUATIONS + cont = (CONTINUATION *)malloc(sizeof(CONTINUATION)); + if (!cont) return 0; + cont->length = 0; + cont->stkbse = parent_cont->stkbse; +#else + long j; + register STACKITEM *src, *dst; + FLUSH_REGISTER_WINDOWS; + j = stack_size(parent_cont->stkbse); + cont = (CONTINUATION *)malloc((sizeof(CONTINUATION) + j*sizeof(STACKITEM))); + if (!cont) return 0; + cont->length = j; + cont->stkbse = parent_cont->stkbse; + src = cont->stkbse; +# ifdef STACK_GROWS_UP + src += parent_cont->length; +# else + src -= parent_cont->length + cont->length; +# endif/* ndef STACK_GROWS_UP */ + dst = (STACKITEM *)(cont + 1); + for (j = cont->length; 0 <= --j; ) *dst++ = *src++; +#endif /* ndef CHEAP_CONTINUATIONS */ + cont->parent = parent_cont; + return cont; +} + +/* free_continuation() is trivial, but who knows what the future + holds. */ + +void free_continuation(cont) + CONTINUATION *cont; +{ + free(cont); +} + +/* Final routine involved in throw()ing to a continuation. After + ensuring that there is sufficient room on the stack for the saved + continuation, dynthrow() copies the continuation onto the stack and + longjmp()s into it. The routine does not return. */ + +/* If you use conservative GC and your Sparc(SUN-4) heap is growing + out of control: + + You are experiencing a GC problem peculiar to the Sparc. The + problem is that contin doesn't know how to clear register windows. + Every location which is not reused still gets marked at GC time. + This causes lots of stuff which should be collected to not be. + This will be a problem with any *conservative* GC until we find + what instruction will clear the register windows. This problem is + exacerbated by using lots of make-CONTINUATION. + + Possibly adding the following before the thrown_value = val; line + might help to clear out unused stack above the continuation (a + small part of the problem). + +#ifdef sparc + bzero((void *)&a, sizeof(STACKITEM) * + (((STACKITEM *)&a) - (dst - cont->length))) +#endif + + Let me know if you try it. */ + +void dynthrow(a) + long *a; +{ + register CONTINUATION *cont = (CONTINUATION *)(a[0]); + long val = a[1]; +#ifndef CHEAP_CONTINUATIONS + register long j; + register STACKITEM *src, *dst = cont->stkbse; +# ifdef STACK_GROWS_UP + if (a[2] && (a - ((long *)a[3]) < 100)) + puts("grow_throw: check if long growth[100]; being optimized out"); + /* if (a[2]) fprintf(stderr, " ct = %ld, dist = %ld\n", a[2], (((long *)a[3]) - a)); */ + if PTR_GE(dst + (cont->length), (STACKITEM *)&a) grow_throw(a); +# else + if (a[2] && (((long *)a[3]) - a < 100)) + puts("grow_throw: check if long growth[100]; being optimized out"); + /* if (a[2]) fprintf(stderr, " ct = %ld, dist = %ld\n", a[2], (((long *)a[3]) - a)); */ + dst -= cont->length; + if PTR_LE(dst, (STACKITEM *)&a) grow_throw(a); +# endif/* def STACK_GROWS_UP */ + FLUSH_REGISTER_WINDOWS; + src = (STACKITEM *)(cont + 1); + for (j = cont->length;0 <= --j;) *dst++ = *src++; +#endif /* ndef CHEAP_CONTINUATIONS */ +#ifdef SHORT_INT + thrown_value = val; + longjmp(cont->jmpbuf, 1); +#else + longjmp(cont->jmpbuf, val); +#endif +} + +/* grow_throw() grows the stack by 100 long words. If the "sizeof + growth" assignment is not sufficient to restrain your overly + optimistic compiler, the stack will grow by much less and + grow_throw() and dynthrow() will waste time calling each other. To + fix this you will have to compile grow_throw() in a separate file + so the compiler won't be able to guess that the growth array isn't + all used. */ + +#ifndef CHEAP_CONTINUATIONS +void grow_throw(a) /* Grow the stack so that there is room */ + long *a; /* to copy in the continuation. Then */ +{ /* retry the throw. */ + long growth[100]; + growth[0] = a[0]; + growth[1] = a[1]; + growth[2] = a[2] + 1; + growth[3] = (long) a; + growth[99] = sizeof growth; + dynthrow(growth); +} +#endif /* ndef CHEAP_CONTINUATIONS */ + +/* throw_to_continuation() restores the stack in effect when + @var{cont} was made and resumes @var{cont}'s processor state. If + the stack cannot be resotred because @var{cont} and @var{root_cont} + do not have the same stkbase, @code{throw_to_continuation() + returns. */ + +/* Note: If 2 or more @var{cont}s share a parent continuation and if + the values of stack allocated variables in that parent continuation + are changed, the results are unspecified. This is because the + parent continuation may or may not be reloaded, depending on what + other throws have intervened. */ + +void throw_to_continuation(cont, val, root_cont) + CONTINUATION *cont; + long val; + CONTINUATION *root_cont; +{ + long a[3]; + a[0] = (long)cont; + a[1] = val; + a[2] = 0; + if (cont->stkbse != root_cont->stkbse) + return; /* Stale continuation */ + dynthrow(a); +} |