mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-15 16:20:17 +02:00
Fix errors introduced when giving multiple-values objects a tc7
* libguile/values.c (scm_c_value_ref): Fix a case in which a request for
the 0th value of a zero-valued object would return the object instead
of erroring.
* libguile/vm-engine.c (halt): Fix construction of a multiple-valued
return (off-by-one error). Fixes a crash introduced in
4a2d78b4d4
.
This commit is contained in:
parent
0465c8834e
commit
e6461cf1b2
2 changed files with 11 additions and 5 deletions
|
@ -59,10 +59,16 @@ scm_c_nvalues (SCM obj)
|
|||
SCM
|
||||
scm_c_value_ref (SCM obj, size_t idx)
|
||||
{
|
||||
if (SCM_LIKELY (scm_is_values (obj) && idx < scm_i_nvalues (obj)))
|
||||
if (scm_is_values (obj))
|
||||
{
|
||||
if (idx < scm_i_nvalues (obj))
|
||||
return scm_i_value_ref (obj, idx);
|
||||
else if (idx == 0)
|
||||
}
|
||||
else
|
||||
{
|
||||
if (idx == 0)
|
||||
return obj;
|
||||
}
|
||||
|
||||
scm_error (scm_out_of_range_key,
|
||||
"scm_c_value_ref",
|
||||
|
|
|
@ -335,7 +335,7 @@ VM_NAME (scm_thread *thread)
|
|||
VM_ASSERT (nvals <= (UINTPTR_MAX >> 8), abort ());
|
||||
ret = scm_words ((nvals << 8) | scm_tc7_values, nvals + 1);
|
||||
for (n = 0; n < nvals; n++)
|
||||
SCM_SET_CELL_OBJECT (ret, n+1, FP_REF (4 + n - 1));
|
||||
SCM_SET_CELL_OBJECT (ret, n+1, FP_REF (4 + n));
|
||||
}
|
||||
|
||||
VP->ip = SCM_FRAME_RETURN_ADDRESS (VP->fp);
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue