mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +02:00
Code Activity

simplify handling of nonlocal prompt returns from c

Browse source 
* libguile/control.h:
* libguile/control.c (scm_i_prompt_pop_abort_args_x): New helper.

* libguile/eval.c (eval): Use the new helper.
This commit is contained in:
Andy Wingo 2010-02-25 13:17:34 +01:00
parent da7fa082e8
commit b8af64db76
3 changed files with 24 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

20
libguile/control.c
View file

@ -57,6 +57,26 @@ scm_c_make_prompt (SCM vm, SCM k, scm_t_uint8 escape_only_p,
return ret; return ret;
} }
/* Only to be called if the SCM_PROMPT_SETJMP returns 1 */
SCM
scm_i_prompt_pop_abort_args_x (SCM prompt)
{
size_t i, n;
SCM vals = SCM_EOL;
n = scm_to_size_t (SCM_PROMPT_REGISTERS (prompt)->sp[0]);
for (i = 0; i < n; i++)
vals = scm_cons (SCM_PROMPT_REGISTERS (prompt)->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 (scm_the_vm ())->sp -= n + 1;
/* FIXME NULLSTACK */
return vals;
}
#ifdef WORDS_BIGENDIAN #ifdef WORDS_BIGENDIAN
#define OBJCODE_HEADER(main,meta) 0, 0, 0, main, 0, 0, 0, meta+8 #define OBJCODE_HEADER(main,meta) 0, 0, 0, main, 0, 0, 0, meta+8
#define META_HEADER(meta) 0, 0, 0, meta, 0, 0, 0, 0 #define META_HEADER(meta) 0, 0, 0, meta, 0, 0, 0, 0

2
libguile/control.h
View file

@ -47,6 +47,8 @@ SCM_INTERNAL SCM scm_sys_default_prompt_tag;
SCM_INTERNAL SCM scm_c_make_prompt (SCM vm, SCM k, scm_t_uint8 escape_only_p, SCM_INTERNAL SCM scm_c_make_prompt (SCM vm, SCM k, scm_t_uint8 escape_only_p,
scm_t_int64 cookie); scm_t_int64 cookie);
SCM_INTERNAL SCM scm_i_prompt_pop_abort_args_x (SCM prompt);
SCM_INTERNAL SCM scm_c_abort (SCM vm, SCM tag, size_t n, SCM *argv, SCM_INTERNAL SCM scm_c_abort (SCM vm, SCM tag, size_t n, SCM *argv,
scm_t_int64 cookie) SCM_NORETURN; scm_t_int64 cookie) SCM_NORETURN;
SCM_INTERNAL SCM scm_at_abort (SCM tag, SCM args) SCM_NORETURN; SCM_INTERNAL SCM scm_at_abort (SCM tag, SCM args) SCM_NORETURN;

15
libguile/eval.c
View file

@ -435,20 +435,9 @@ eval (SCM x, SCM env)
if (SCM_PROMPT_SETJMP (prompt)) if (SCM_PROMPT_SETJMP (prompt))
{ {
/* The prompt exited nonlocally. The args are on the VM stack. */ /* The prompt exited nonlocally. */
size_t i, n;
SCM vals = SCM_EOL;
n = scm_to_size_t (SCM_PROMPT_REGISTERS (prompt)->sp[0]);
for (i = 0; i < n; i++)
vals = scm_cons (SCM_PROMPT_REGISTERS (prompt)->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 (scm_the_vm ())->sp -= n + 1;
/* FIXME NULLSTACK */
/* FIXME mark cont as non-reentrant */
proc = handler; proc = handler;
args = vals; args = scm_i_prompt_pop_abort_args_x (prompt);
goto apply_proc; goto apply_proc;
} }