On Fri, Sep 27, 2024 at 10:45:52PM +0200, Mario Domenech Goulart wrote:
> Hi,
>
> Attached is a patch to fix the call to barf when handling u8vector-set!
> out-of-range errors.  Reported by puck in #chicken.

Hi Mario,

This patch works, but it led me down a rabbit hole.

So, as you can see, in runtime.c we have a case for C_OUT_OF_RANGE_ERROR
in barf() which expects 4 arguments.  That's the error number, the
location as a string and two extra arguments which are (I think)
intended to be a "context" and the irritant.  For instance, if you
call (u8vector-set! #u8() 2 0), it complains and gives you the vector
(context) and the index in the "arguments" property of the condition.

This then is put on the stack and handed of too ##sys#error-hook to
construct the condition and call the exception handler.

But now take a look at the definition of ##sys#check-range, the
Scheme procedure which AFAICT is the only one which corresponds
directly to such barf calls:

    (define (##sys#check-range i from to . loc)
      (##sys#check-fixnum i loc)
      (unless (and (fx<= from i) (fx< i to))
        (##sys#error-hook
         (foreign-value "C_OUT_OF_RANGE_ERROR" int)
         (and (pair? loc) (car loc)) i from to) ) )

This calls ##sys#error-hook with the error code (C_OUT_OF_RANGE_ERROR,
the value of which is 8) as the first argument, and either #f or the
location as the second argument and "i" (the index being checked, which
is the "irritant") as the third argument.  Then it passes "from" and
"to" as the fourth and fifth arguments for "context", respectively.

This means the condition will look differently when it's raised directly
from Scheme.  Compare:

    #;1> (import srfi-4)
    #;2> (u8vector-set! #u8() 1 300)
    
    Error: (u8vector-set!) out of range
    #u8()
    1
    #;2> ,exn
    condition: (exn bounds)
     exn
            message: "out of range"
            arguments: (#u8() 1)
            call-chain: (#("<stdin>:3" (u8vector-set! #u8() 1 300) #f) 
#("<stdin>:3" (u8vector-set! #u8() 1 300) #...
            location: u8vector-set!
     bounds

With:

    #;1> (subvector #() 1 2)
    
    Error: (subvector) out of range
    1
    0
    1
    #;1> ,exn
    condition: (exn bounds)
     exn
            message: "out of range"
            arguments: (1 0 1)
            call-chain: (#("<stdin>:1" (subvector #() 1 2) #f) #("<stdin>:1" 
(subvector #() 1 2) #<frameinfo>))
            location: subvector
     bounds

I think we should think about how to ensure the C calls match the Scheme
calls, and bring those in line.

Note that the definitions for check-uint-length and check-int-length in
srfi-4.scm match up with ##sys#check-range - they pass the irritant and
the from/to values to ##sys#error-hook.

There is also a direct ##sys#error-hook call with C_OUT_OF_RANGE_ERROR
in substring-index(-ci) in data-structures.scm and scheme#substring in
library.scm also seems to be missing one argument.

There are quite a few places in runtime.c where we call
C_OUT_OF_RANGE_ERROR with the context and the irritant alone, we'd have
to change all of those to call it with the irritant, min and max value.

I think we'd do best to completely replace all barf(C_OUT_OF_RANGE, ...)
calls in a bigger patch and make it use 5 instead of 4 arguments.

But for now, attached is a small modified version of your patch which
brings u8vector-set!  in line with s8vector-set! and the f32 and f64vector
setters, which use C_BAD_ARGUMENT_TYPE_ERROR.  I also fixed the other
srfi-4 setters which had this incorrect call.

On the longer term, I think it's probably better to completely refactor
barf() and ##sys#error-hook.  Currently there's a lot of duplication in
the error string, the foreign integer values have to be duplicated
as literals in the case expression and the argument counts need
to line up correctly.  As we've seen this is not easy to get
right, resulting in inconsistencies in the structure of the condition
objects that get constructed.  This would definitely be a problem
for code that tries to inspect such condition objects.

Cheers,
Peter
>From e769c0397462e857af255b91a13752976a15291a Mon Sep 17 00:00:00 2001
From: Mario Domenech Goulart <[email protected]>
Date: Fri, 27 Sep 2024 22:35:57 +0200
Subject: [PATCH] Fix barf calls for out-of-range values for srfi-4 setters

Instead of an invalid call to C_OUT_OF_RANGE with not enough
arguments, use C_BAD_ARGUMENT_TYPE with just the one argument.

This matches the existing implementations of s8vector-set! and
f{32,64}vector-set!

Reported by puck in #chicken.

Signed-off-by: Peter Bex <[email protected]>
---
 manual/Acknowledgements |  2 +-
 runtime.c               | 14 +++++++-------
 2 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/manual/Acknowledgements b/manual/Acknowledgements
index 8e6ac12b..3e7dd0cd 100644
--- a/manual/Acknowledgements
+++ b/manual/Acknowledgements
@@ -37,7 +37,7 @@ Fadi Moukayed, Chris Moline, Eric E. Moore, Julian Morrison,
 Dan Muresan, David N. Murray, Timo Myyrä, "nicktick", Lars Nilsson,
 Ian Oversby, "o.t.", Gene Pavlovsky, Levi Pearson, Jeronimo Pellegrini,
 Nicolas Pelletier, Derrell Piper, Carlos Pita, "Pluijzer",
-Robin Lee Powell, Alan Post, "Pupeno", Davide Puricelli, "presto",
+Robin Lee Powell, Alan Post, "puck", "Pupeno", Davide Puricelli, "presto",
 Doug Quale, Imran Rafique, Eric Raible, Ivan Raikov, Santosh Rajan,
 Peder Refnes, Joel Reymont, Kay Rhodes, "rivo", Chris Roberts,
 Eric Rochester, Paul Romanchenko,
diff --git a/runtime.c b/runtime.c
index 29dbcb00..53a3250a 100644
--- a/runtime.c
+++ b/runtime.c
@@ -6112,7 +6112,7 @@ C_regparm C_word C_fcall C_i_u8vector_set(C_word v, 
C_word i, C_word x)
 
     if(x & C_FIXNUM_BIT) {
       if (!(x & C_INT_SIGN_BIT) && C_ilen(C_unfix(x)) <= 8) n = C_unfix(x);
-      else barf(C_OUT_OF_RANGE_ERROR, "u8vector-set!", x);
+      else barf(C_BAD_ARGUMENT_TYPE_ERROR, "u8vector-set!", x);
     }
     else barf(C_BAD_ARGUMENT_TYPE_ERROR, "u8vector-set!", x);
   }
@@ -6162,7 +6162,7 @@ C_regparm C_word C_fcall C_i_u16vector_set(C_word v, 
C_word i, C_word x)
 
     if(x & C_FIXNUM_BIT) {
       if (!(x & C_INT_SIGN_BIT) && C_ilen(C_unfix(x)) <= 16) n = C_unfix(x);
-      else barf(C_OUT_OF_RANGE_ERROR, "u16vector-set!", x);
+      else barf(C_BAD_ARGUMENT_TYPE_ERROR, "u16vector-set!", x);
     }
     else barf(C_BAD_ARGUMENT_TYPE_ERROR, "u16vector-set!", x);
   }
@@ -6187,7 +6187,7 @@ C_regparm C_word C_fcall C_i_s16vector_set(C_word v, 
C_word i, C_word x)
 
     if(x & C_FIXNUM_BIT) {
       if (C_unfix(C_i_fixnum_length(x)) <= 16) n = C_unfix(x);
-      else barf(C_OUT_OF_RANGE_ERROR, "s16vector-set!", x);
+      else barf(C_BAD_ARGUMENT_TYPE_ERROR, "s16vector-set!", x);
     }
     else barf(C_BAD_ARGUMENT_TYPE_ERROR, "s16vector-set!", x);
   }
@@ -6212,7 +6212,7 @@ C_regparm C_word C_fcall C_i_u32vector_set(C_word v, 
C_word i, C_word x)
 
     if(C_truep(C_i_exact_integerp(x))) {
       if (C_unfix(C_i_integer_length(x)) <= 32) n = C_num_to_unsigned_int(x);
-      else barf(C_OUT_OF_RANGE_ERROR, "u32vector-set!", x);
+      else barf(C_BAD_ARGUMENT_TYPE_ERROR, "u32vector-set!", x);
     }
     else barf(C_BAD_ARGUMENT_TYPE_ERROR, "u32vector-set!", x);
   }
@@ -6237,7 +6237,7 @@ C_regparm C_word C_fcall C_i_s32vector_set(C_word v, 
C_word i, C_word x)
 
     if(C_truep(C_i_exact_integerp(x))) {
       if (C_unfix(C_i_integer_length(x)) <= 32) n = C_num_to_int(x);
-      else barf(C_OUT_OF_RANGE_ERROR, "s32vector-set!", x);
+      else barf(C_BAD_ARGUMENT_TYPE_ERROR, "s32vector-set!", x);
     }
     else barf(C_BAD_ARGUMENT_TYPE_ERROR, "s32vector-set!", x);
   }
@@ -6262,7 +6262,7 @@ C_regparm C_word C_fcall C_i_u64vector_set(C_word v, 
C_word i, C_word x)
 
     if(C_truep(C_i_exact_integerp(x))) {
       if (C_unfix(C_i_integer_length(x)) <= 64) n = C_num_to_uint64(x);
-      else barf(C_OUT_OF_RANGE_ERROR, "u64vector-set!", x);
+      else barf(C_BAD_ARGUMENT_TYPE_ERROR, "u64vector-set!", x);
     }
     else barf(C_BAD_ARGUMENT_TYPE_ERROR, "u64vector-set!", x);
   }
@@ -6287,7 +6287,7 @@ C_regparm C_word C_fcall C_i_s64vector_set(C_word v, 
C_word i, C_word x)
 
     if(C_truep(C_i_exact_integerp(x))) {
       if (C_unfix(C_i_integer_length(x)) <= 64) n = C_num_to_int64(x);
-      else barf(C_OUT_OF_RANGE_ERROR, "s64vector-set!", x);
+      else barf(C_BAD_ARGUMENT_TYPE_ERROR, "s64vector-set!", x);
     }
     else barf(C_BAD_ARGUMENT_TYPE_ERROR, "s64vector-set!", x);
   }
-- 
2.44.1

Reply via email to