mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-15 16:20:17 +02:00
Code Activity

error if given an unrewindable partial continuation

Browse source 
* libguile/vm-engine.c (vm_error_continuation_not_rewindable):
* libguile/vm-i-system.c (partial-cont-call):
* libguile/vm.h (SCM_VM_CONT_PARTIAL_P):
  (SCM_VM_CONT_REWINDABLE_P): Fix a bug in which we weren't checking if
  a partial continuation was actually rewindable.
This commit is contained in:
Andy Wingo 2010-02-25 00:18:07 +01:00
parent 35ac785286
commit b3950ad6d8
3 changed files with 11 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

5
libguile/vm-engine.c
View file

@ -233,6 +233,11 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
finish_args = SCM_EOL; finish_args = SCM_EOL;
goto vm_error; goto vm_error;
vm_error_continuation_not_rewindable:
err_msg = scm_from_locale_string ("Unrewindable partial continuation");
finish_args = scm_cons (finish_args, SCM_EOL);
goto vm_error;
vm_error_bad_wide_string_length: vm_error_bad_wide_string_length:
err_msg = scm_from_locale_string ("VM: Bad wide string length: ~S"); err_msg = scm_from_locale_string ("VM: Bad wide string length: ~S");
goto vm_error; goto vm_error;

4
libguile/vm-i-system.c
View file

@ -999,6 +999,10 @@ VM_DEFINE_INSTRUCTION (94, partial_cont_call, "partial-cont-call", 0, -1, 0)
POP (intwinds); POP (intwinds);
POP (vmcont); POP (vmcont);
SYNC_REGISTER (); SYNC_REGISTER ();
if (SCM_UNLIKELY (!SCM_VM_CONT_REWINDABLE_P (vmcont)))
{ finish_args = vmcont;
goto vm_error_continuation_not_rewindable;
}
vm_reinstate_partial_continuation (vm, vmcont, intwinds, sp + 1 - fp, fp); vm_reinstate_partial_continuation (vm, vmcont, intwinds, sp + 1 - fp, fp);
CACHE_REGISTER (); CACHE_REGISTER ();
program = SCM_FRAME_PROGRAM (fp); program = SCM_FRAME_PROGRAM (fp);

4
libguile/vm.h
View file

@ -102,8 +102,8 @@ struct scm_vm_cont {
#define SCM_VM_CONT_P(OBJ) (SCM_NIMP (OBJ) && SCM_TYP7 (OBJ) == scm_tc7_vm_cont) #define SCM_VM_CONT_P(OBJ) (SCM_NIMP (OBJ) && SCM_TYP7 (OBJ) == scm_tc7_vm_cont)
#define SCM_VM_CONT_DATA(CONT) ((struct scm_vm_cont *) SCM_CELL_WORD_1 (CONT)) #define SCM_VM_CONT_DATA(CONT) ((struct scm_vm_cont *) SCM_CELL_WORD_1 (CONT))
#define SCM_VM_CONT_PARTIAL_P(CONT) (SCM_VM_CONT_DATA (CONT) & SCM_F_VM_CONT_PARTIAL) #define SCM_VM_CONT_PARTIAL_P(CONT) (SCM_VM_CONT_DATA (CONT)->flags & SCM_F_VM_CONT_PARTIAL)
#define SCM_VM_CONT_REWINDABLE_P(CONT) (SCM_VM_CONT_DATA (CONT) & SCM_F_VM_CONT_REWINDABLE) #define SCM_VM_CONT_REWINDABLE_P(CONT) (SCM_VM_CONT_DATA (CONT)->flags & SCM_F_VM_CONT_REWINDABLE)
SCM_API SCM scm_load_compiled_with_vm (SCM file); SCM_API SCM scm_load_compiled_with_vm (SCM file);