diff options
Diffstat (limited to 'SCM/continue.c')
| -rw-r--r-- | SCM/continue.c | 242 |
1 files changed, 0 insertions, 242 deletions
diff --git a/SCM/continue.c b/SCM/continue.c deleted file mode 100644 index 1f8c6de..0000000 --- a/SCM/continue.c +++ /dev/null @@ -1,242 +0,0 @@ -/* "continue.c" Scheme Continuations for C. - * Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1997 Free Software Foundation, Inc. - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as - * published by the Free Software Foundation, either version 3 of the - * License, 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 - * Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public - * License along with this program. If not, see - * <http://www.gnu.org/licenses/>. - */ - -/* 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 setjump 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 `setjump(new_continuation->jmpbuf)' in order to complete the - capture of this continuation. */ - -#ifndef __ia64__ -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 - `setjump(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; -} -#endif - -/* 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 - longjump()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 SCM 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. */ - -/* SCM_GROWTH is how many `long's to grow the stack by when we need room. */ -#define SCM_GROWTH 100 - -#ifndef __ia64__ -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 -# ifndef hpux - if (a[2] && (a - ((long *)a[3]) < SCM_GROWTH)) - puts("grow_throw: check if long growth[]; being optimized out"); -# endif - /* 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 -# ifndef hpux - if (a[2] && (((long *)a[3]) - a < SCM_GROWTH)) - puts("grow_throw: check if long growth[]; being optimized out"); -# endif - /* 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; - longjump(cont->jmpbuf, 1); -# else - longjump(cont->jmpbuf, val); -# endif -} - -/* grow_throw() grows the stack by SCM_GROWTH 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[SCM_GROWTH]; - growth[0] = a[0]; - growth[1] = a[1]; - growth[2] = a[2] + 1; - growth[3] = (long) a; - growth[SCM_GROWTH-1] = sizeof growth; - dynthrow(growth); -} -# endif /* ndef CHEAP_CONTINUATIONS */ -#endif - -/* 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); -} |