~ chicken-core (chicken-5) 4746bd9556b7650c279c718bb0d5edf2c5ca5b01
commit 4746bd9556b7650c279c718bb0d5edf2c5ca5b01
Author: Jani Hakala <jahakala@iki.fi>
AuthorDate: Wed Nov 20 21:37:03 2019 +0200
Commit: Kooda <kooda@upyum.com>
CommitDate: Thu Nov 28 13:22:10 2019 +0100
Fix incorrect bignum allocation sizes
Memory allocation problems were detected by AddressSanitizer provided
by gcc 9.2.1. When lolevel-tests.scm was run, AddressSanitizer pointed
out bignum1 and bignum2 related problems in library.scm and srfi-4.scm.
In library.scm, C_bignum2 needs 4 words (header, sign and the two digit
words), plus the 2 words for the bignum wrapper.
In srfi-4.scm, the [su]32vector-ref functions might ultimately call
C_bignum1, which needs 5 words.
Signed-off-by: Evan Hanson <evhan@foldling.org>
Signed-off-by: Kooda <kooda@upyum.com>
diff --git a/c-platform.scm b/c-platform.scm
index 61a4ac87..6e1463cb 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -78,6 +78,7 @@
(define default-units '(library eval))
(define words-per-flonum 4)
+(define min-words-per-bignum 5)
(eq-inline-operator "C_eqp")
(membership-test-operators
@@ -968,8 +969,11 @@
(rewrite 'chicken.memory#pointer-f32-set! 2 2 "C_u_i_pointer_f32_set" #f)
(rewrite 'chicken.memory#pointer-f64-set! 2 2 "C_u_i_pointer_f64_set" #f)
-(rewrite 'chicken.memory#pointer-u32-ref 16 1 "C_a_u_i_pointer_u32_ref" #f words-per-flonum)
-(rewrite 'chicken.memory#pointer-s32-ref 16 1 "C_a_u_i_pointer_s32_ref" #f words-per-flonum)
+;; on 32-bit platforms, 32-bit integers do not always fit in a word,
+;; bignum1 and bignum wrapper (5 words) may be used instead
+(rewrite 'chicken.memory#pointer-u32-ref 16 1 "C_a_u_i_pointer_u32_ref" #f min-words-per-bignum)
+(rewrite 'chicken.memory#pointer-s32-ref 16 1 "C_a_u_i_pointer_s32_ref" #f min-words-per-bignum)
+
(rewrite 'chicken.memory#pointer-f32-ref 16 1 "C_a_u_i_pointer_f32_ref" #f words-per-flonum)
(rewrite 'chicken.memory#pointer-f64-ref 16 1 "C_a_u_i_pointer_f64_ref" #f words-per-flonum)
@@ -1074,8 +1078,8 @@
(rewrite 'srfi-4#s16vector-ref 2 2 "C_u_i_s16vector_ref" #f)
(rewrite 'srfi-4#s16vector-ref 2 2 "C_i_s16vector_ref" #t)
-(rewrite 'srfi-4#u32vector-ref 16 2 "C_a_i_u32vector_ref" #t words-per-flonum)
-(rewrite 'srfi-4#s32vector-ref 16 2 "C_a_i_s32vector_ref" #t words-per-flonum)
+(rewrite 'srfi-4#u32vector-ref 16 2 "C_a_i_u32vector_ref" #t min-words-per-bignum)
+(rewrite 'srfi-4#s32vector-ref 16 2 "C_a_i_s32vector_ref" #t min-words-per-bignum)
(rewrite 'srfi-4#f32vector-ref 16 2 "C_a_u_i_f32vector_ref" #f words-per-flonum)
(rewrite 'srfi-4#f32vector-ref 16 2 "C_a_i_f32vector_ref" #t words-per-flonum)
diff --git a/library.scm b/library.scm
index e52d1452..7b8c577a 100644
--- a/library.scm
+++ b/library.scm
@@ -2468,7 +2468,7 @@ EOF
(end (or hashes digits)))
(and-let* ((end)
(num (##core#inline_allocate
- ("C_s_a_i_digits_to_integer" 5)
+ ("C_s_a_i_digits_to_integer" 6)
str start (car end) radix neg?)))
(when hashes ; Eeewww. Feeling dirty yet?
(set! seen-hashes? #t)
@@ -2482,7 +2482,7 @@ EOF
(and-let* ((start (if sign (fx+ start 1) start))
(end (scan-digits start)))
(cons (##core#inline_allocate
- ("C_s_a_i_digits_to_integer" 5)
+ ("C_s_a_i_digits_to_integer" 6)
str start (car end) radix (eq? sign 'neg))
(cdr end)))))))
(scan-decimal-tail ; The part after the decimal dot
diff --git a/srfi-4.scm b/srfi-4.scm
index 6faaa475..537d8288 100644
--- a/srfi-4.scm
+++ b/srfi-4.scm
@@ -209,13 +209,13 @@ EOF
(define u32vector-ref
(getter-with-setter
- (lambda (x i) (##core#inline_allocate ("C_a_i_u32vector_ref" 4) x i))
+ (lambda (x i) (##core#inline_allocate ("C_a_i_u32vector_ref" 5) x i))
u32vector-set!
"(chicken.srfi-4#u32vector-ref v i)"))
(define s32vector-ref
(getter-with-setter
- (lambda (x i) (##core#inline_allocate ("C_a_i_s32vector_ref" 4) x i))
+ (lambda (x i) (##core#inline_allocate ("C_a_i_s32vector_ref" 5) x i))
s32vector-set!
"(chicken.srfi-4#s32vector-ref v i)"))
Trap