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

RTL VM: receive-values has allow-extra? flag

Browse source 
* libguile/vm-engine.c (receive-values): Add an ALLOW-EXTRA? flag in
  unused bits of the third word.  Without it, receive-values will check
  for the exact number of incoming values.

* libguile/vm.c (vm_error_wrong_number_of_values): New error case.

* module/language/cps/compile-rtl.scm (emit-rtl-sequence): Adapt to add
  the ALLOW-EXTRA? flag.
This commit is contained in:
Andy Wingo 2013-10-14 16:09:43 +02:00
parent c6cd692f08
commit 82f4bac420
3 changed files with 23 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

13
libguile/vm-engine.c
View file

@ -1059,20 +1059,25 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
NEXT (2);
}
/* receive-values proc:24 _:8 nvalues:24
/* receive-values proc:24 allow-extra?:1 _:7 nvalues:24
*
* Receive a return of multiple values from a call whose procedure was
* in PROC. If fewer than NVALUES values were returned, signal an
* error. After receive-values has run, the values can be copied down
* via `mov'.
* error. Unless ALLOW-EXTRA? is true, require that the number of
* return values equals NVALUES exactly. After receive-values has
* run, the values can be copied down via `mov'.
*/
VM_DEFINE_OP (4, receive_values, "receive-values", OP2 (U8_U24, X8_U24))
VM_DEFINE_OP (4, receive_values, "receive-values", OP2 (U8_U24, B1_X7_U24))
{
scm_t_uint32 proc, nvalues;
SCM_UNPACK_RTL_24 (op, proc);
SCM_UNPACK_RTL_24 (ip[1], nvalues);
if (ip[1] & 0x1)
VM_ASSERT (FRAME_LOCALS_COUNT () > proc + nvalues,
vm_error_not_enough_values ());
else
VM_ASSERT (FRAME_LOCALS_COUNT () == proc + nvalues,
vm_error_wrong_number_of_values (nvalues));
NEXT (2);
}

8
libguile/vm.c
View file

@ -429,6 +429,7 @@ static void vm_error_not_a_bytevector (const char *subr, SCM x) SCM_NORETURN SCM
static void vm_error_not_a_struct (const char *subr, SCM x) SCM_NORETURN SCM_NOINLINE;
static void vm_error_no_values (void) SCM_NORETURN SCM_NOINLINE;
static void vm_error_not_enough_values (void) SCM_NORETURN SCM_NOINLINE;
static void vm_error_wrong_number_of_values (scm_t_uint32 expected) SCM_NORETURN SCM_NOINLINE;
static void vm_error_continuation_not_rewindable (SCM cont) SCM_NORETURN SCM_NOINLINE;
static void vm_error_bad_wide_string_length (size_t len) SCM_NORETURN SCM_NOINLINE;
@ -577,6 +578,13 @@ vm_error_not_enough_values (void)
vm_error ("Too few values returned to continuation", SCM_UNDEFINED);
}
static void
vm_error_wrong_number_of_values (scm_t_uint32 expected)
{
vm_error ("Wrong number of values returned to continuation (expected ~a)",
scm_from_uint32 (expected));
}
static void
vm_error_continuation_not_rewindable (SCM cont)
{

5
module/language/cps/compile-rtl.scm
View file

@ -273,7 +273,10 @@
(match args
(()
(emit-call asm proc-slot (+ nargs 1))
(emit-receive-values asm proc-slot nreq)
;; FIXME: Only allow more values if there is a rest arg.
;; Express values truncation by the presence of an
;; unused rest arg instead of implicitly.
(emit-receive-values asm proc-slot #t nreq)
(when rest?
(emit-bind-rest asm (+ proc-slot 1 nreq)))
(for-each (match-lambda