X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/92c2555f6972b5fbc2236fe486e9432040b43812..9bc6fb0a7d91ae9a6c57cedb76022043db413ba5:/libguile/root.c diff --git a/libguile/root.c b/libguile/root.c index 793103f49..389c2247b 100644 --- a/libguile/root.c +++ b/libguile/root.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000, 2001 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 @@ -39,8 +39,6 @@ * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. */ -/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999, - gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */ @@ -75,8 +73,6 @@ root_mark (SCM root) scm_gc_mark (s->rootcont); scm_gc_mark (s->dynwinds); - scm_gc_mark (s->continuation_stack); - scm_gc_mark (s->continuation_stack_ptr); scm_gc_mark (s->progargs); scm_gc_mark (s->exitval); scm_gc_mark (s->cur_inp); @@ -109,8 +105,8 @@ scm_make_root (SCM parent) SCM root; scm_root_state *root_state; - root_state = (scm_root_state *) scm_must_malloc (sizeof (scm_root_state), - "scm_make_root"); + root_state = (scm_root_state *) scm_gc_malloc (sizeof (scm_root_state), + "root state"); if (SCM_ROOTP (parent)) { memcpy (root_state, SCM_ROOT_STATE (parent), sizeof (scm_root_state)); @@ -124,8 +120,6 @@ scm_make_root (SCM parent) /* Initialize everything right now, in case a GC happens early. */ root_state->rootcont = root_state->dynwinds - = root_state->continuation_stack - = root_state->continuation_stack_ptr = root_state->progargs = root_state->exitval = root_state->cur_inp @@ -253,8 +247,8 @@ scm_internal_cwdr (scm_t_catch_body body, void *body_data, SCM_REDEFER_INTS; { - scm_t_contregs *contregs = scm_must_malloc (sizeof (scm_t_contregs), - "inferior root continuation"); + scm_t_contregs *contregs = scm_gc_malloc (sizeof (scm_t_contregs), + "continuation"); contregs->num_stack_items = 0; contregs->dynenv = SCM_EOL; @@ -384,46 +378,6 @@ scm_apply_with_dynamic_root (SCM proc, SCM a1, SCM args, SCM handler) -#if (SCM_DEBUG_DEPRECATED == 0) - -/* Call thunk(closure) underneath a top-level error handler. - * If an error occurs, pass the exitval through err_filter and return it. - * If no error occurs, return the value of thunk. - */ - -#ifdef _UNICOS -typedef int setjmp_type; -#else -typedef long setjmp_type; -#endif - - -SCM -scm_call_catching_errors (SCM (*thunk)(), SCM (*err_filter)(), void *closure) -{ - SCM answer; - setjmp_type i; -#ifdef DEBUG_EXTENSIONS - SCM_DFRAME (scm_rootcont) = scm_last_debug_frame; -#endif - i = setjmp (SCM_JMPBUF (scm_rootcont)); - scm_stack_checking_enabled_p = SCM_STACK_CHECKING_P; - if (!i) - { - scm_gc_heap_lock = 0; - answer = thunk (closure); - } - else - { - scm_gc_heap_lock = 1; - answer = err_filter (scm_exitval, closure); - } - return answer; -} - -#endif /* SCM_DEBUG_DEPRECATED == 0 */ - - void scm_init_root () {