[Chicken-hackers] [PATCH] Fix a few more mistakes in types.db
Hi there,
I found a bug in the specialization for the ROUND procedure; the
specialization calls C_a_i_flonum_round while it should call
C_a_i_flonum_round_proper. This results in a difference when the
following program is interpreted versus when it is compiled with
various levels of optimization:
(print (round 4.5)) ;; 5.0 when compiled with -O3 or higher, 4.0 otherwise
The correct answer is 4.0 since R5RS says round needs to round to the
nearest even number when the number is halfway between two integers.
I added a test for this to library-tests.scm, but figured out that
it wasn't compiled at all, which is why this bug wasn't caught by
"make check". Since the library is large and has many specializations,
it makes sense to compile the library test. As we add more tests, these
will automatically test any additional specializations.
After making it compile, I found several more mistakes which I've also
fixed in this patch.
By the way, I don't understand why the continuation test at the end
used to work; when compiled it complains the second time it calls
(k #f) that k is false, which I'd expect. Can someone explain why
this isn't the case in interpreted mode?
Cheers,
Peter
--
http://sjamaan.ath.cx
--
"The process of preparing programs for a digital computer
is especially attractive, not only because it can be economically
and scientifically rewarding, but also because it can be an aesthetic
experience much like composing poetry or music."
-- Donald Knuth
>From e6369cde312b1a03be4c23a37260f87ca7bccb15 Mon Sep 17 00:00:00 2001
From: Peter Bex
Date: Sun, 11 Mar 2012 20:52:01 +0100
Subject: [PATCH] Ensure library-tests are compiled to catch specialization
errors more easily; fix several of those found this way
---
tests/library-tests.scm |8 ++--
tests/runtests.bat |4
tests/runtests.sh |2 ++
types.db|8
4 files changed, 16 insertions(+), 6 deletions(-)
diff --git a/tests/library-tests.scm b/tests/library-tests.scm
index 7a491a0..49b91ca 100644
--- a/tests/library-tests.scm
+++ b/tests/library-tests.scm
@@ -1,12 +1,14 @@
library-tests.scm
-(use srfi-1)
+(use srfi-1 extras)
;; numbers
(assert (= -4.0 (round -4.3)))
+(assert (= -4.0 (round -4.5))) ; R5RS
(assert (= 4.0 (round 3.5)))
+(assert (= 4.0 (round 4.5))); R5RS
(assert (= 4 (round (string->number "7/2"
(assert (= 7 (round 7)))
(assert (zero? (round -0.5))) ; is actually -0.0
@@ -84,6 +86,8 @@
(assert (= (acos 0.5) (fpacos 0.5)))
(assert (= (atan 0.5) (fpatan 0.5)))
(assert (= (atan 42.0 1.2) (fpatan2 42.0 1.2)))
+(assert (= (atan 42.0 1) (fpatan2 42.0 1.0)))
+(assert (= (atan 42 1.0) (fpatan2 42.0 1.0)))
(assert (= (exp 42.0) (fpexp 42.0)))
(assert (= (log 42.0) (fplog 42.0)))
(assert (= (expt 42.0 3.5) (fpexpt 42.0 3.5)))
@@ -248,7 +252,7 @@
(assert (= 2 (p)))
k
-(k #f)
+(and k (k #f))
(assert (= 2 guard-called))
diff --git a/tests/runtests.bat b/tests/runtests.bat
index 88891fa..be16134 100644
--- a/tests/runtests.bat
+++ b/tests/runtests.bat
@@ -103,6 +103,10 @@ if errorlevel 1 exit /b 1
echo library tests ...
%interpret% -s library-tests.scm
if errorlevel 1 exit /b 1
+%compile% -specialize library-tests.scm
+if errorlevel 1 exit /b 1
+a.out
+if errorlevel 1 exit /b 1
%interpret% -s records-and-setters-test.scm
if errorlevel 1 exit /b 1
%compile% records-and-setters-test.scm
diff --git a/tests/runtests.sh b/tests/runtests.sh
index bb68c14..1ec59cd 100644
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -131,6 +131,8 @@ $compile test-gc-hooks.scm
echo " library tests ..."
$interpret -s library-tests.scm
+$compile -specialize library-tests.scm
+./a.out
$interpret -s records-and-setters-test.scm
$compile records-and-setters-test.scm
./a.out
diff --git a/types.db b/types.db
index 5e42fec..465ba2b 100644
--- a/types.db
+++ b/types.db
@@ -418,7 +418,7 @@
(round (#(procedure #:clean #:enforce) round (number) number)
((fixnum) (fixnum) #(1))
((float) (float)
- (##core#inline_allocate ("C_a_i_flonum_round" 4) #(1
+ (##core#inline_allocate ("C_a_i_flonum_round_proper" 4) #(1
(exact->inexact (#(procedure #:clean #:enforce) exact->inexact (number) float)
((float) #(1))
@@ -470,9 +470,9 @@
(##core#inline_allocate ("C_a_i_fix_to_flo" 4)
#(2
((fixnum float)
(##core#inline_allocate ("C_a_i_flonum_atan2" 4)
- (##core#inline_allocate ("C_a_i_fix_to_flo" 4)
#(2))
+ (##core#inline_allocate ("C_a_i_fix_to_flo" 4)
#(1))
#(2)))
- ((float float) (##core#inline_allocate ("C_a_i_flonum_atan2" 4) #(1
+ ((float float) (##core#inline_allocate ("C_a_i_flonum_
Re: [Chicken-hackers] [PATCH] Bugfix for #791 and unpack flonums correctly for integer?
Christian Kellermann writes: > Since I also agree and I *wrote* *this* *patch* we are deadlocked. > Attention! Robots need your help! I had a look at it but am too clueless about that numbers business to give a confident review, alas. Any other takers? ___ Chicken-hackers mailing list Chicken-hackers@nongnu.org https://lists.nongnu.org/mailman/listinfo/chicken-hackers
Re: [Chicken-hackers] [PATCH] Raise error on construction of too large vectors/blobs
To make the confusion complete, here is the right patch
>From 7ebe33e32540324b8c0ffcbbc86cf0618029cf10 Mon Sep 17 00:00:00 2001
From: Christian Kellermann
Date: Sun, 4 Mar 2012 10:16:01 +0100
Subject: [PATCH] Raise error on construction of too large vectors/blobs
"too large" depends on the C_HEADER_SIZE_MASK bits for library blobs
and vectors and decreases with the kind of vector for srfi-4 units.
This patch also adds the respective test cases for library and srfi-4
tests.
The manual section on the srfi-4 unit has been amended to explain the
size limits.
---
library.scm | 14 --
manual/Unit srfi-4 | 18 ++
srfi-4.scm | 32 ++--
tests/library-tests.scm | 33 +
tests/srfi-4-tests.scm | 39 ++-
5 files changed, 119 insertions(+), 17 deletions(-)
diff --git a/library.scm b/library.scm
index 6211584..93bf9cf 100644
--- a/library.scm
+++ b/library.scm
@@ -151,6 +151,7 @@ EOF
(define-constant read-line-buffer-initial-size 1024)
(define-constant default-parameter-vector-size 16)
(define maximal-string-length (foreign-value "C_HEADER_SIZE_MASK"
unsigned-long))
+(define maximal-vector-size (foreign-value "C_HEADER_SIZE_MASK" unsigned-long))
;;; System routines:
@@ -1275,13 +1276,22 @@ EOF
;;; Blob:
+;;; Helper routine for blobs and vectors:
+;;; used in library and srfi-4
+(define (##sys#check-exact-size-limit n limit . loc)
+ (##sys#check-exact n loc)
+ (if (and (##core#inline "C_fixnum_lessp" 0 n)
+ (##core#inline "C_fixnum_greaterp" n limit) )
+(##sys#error loc "size value is not in expected range" n 0 limit) ) )
+
+
(define (##sys#make-blob size)
(let ([bv (##sys#allocate-vector size #t #f #t)])
(##core#inline "C_string_to_bytevector" bv)
bv) )
(define (make-blob size)
- (##sys#check-exact size 'make-blob)
+ (##sys#check-exact-size-limit size maximal-vector-size 'make-blob)
(##sys#make-blob size) )
(define (blob? x)
@@ -1322,7 +1332,7 @@ EOF
(define (vector-set! v i x) (##core#inline "C_i_vector_set" v i x))
(define (##sys#make-vector size . fill)
- (##sys#check-exact size 'make-vector)
+ (##sys#check-exact-size-limit size maximal-vector-size 'make-vector)
(when (fx< size 0) (##sys#error 'make-vector "size is negative" size))
(##sys#allocate-vector
size #f
diff --git a/manual/Unit srfi-4 b/manual/Unit srfi-4
index cbd167f..ff573b8 100644
--- a/manual/Unit srfi-4
+++ b/manual/Unit srfi-4
@@ -13,6 +13,24 @@ Homogeneous numeric vector datatypes. Also see the
[[http://srfi.schemers.org/s
* Constructors allow allocating the storage in non garbage collected memory.
* 64-bit integer vectors ({{u64vector}} and {{s64vector}}) are not supported.
+=== Size limitations
+
+SRFI-4 vectors internally are implemented with a maximum length of
+0xff (on 32bit platforms) or 0xff (on 64bit platforms)
+'''bytes'''. This limits the number of possible vector elements:
+
+* All byte vectors have a maximum number of entries of 0xff (32
+ bit) / 0xff (64 bit)
+
+* All 16 bit vectors have a maximum number of entries of 0x7f (32
+ bit) / 0x7f (64 bit)
+
+* All 32 bit vectors have a maximum number of entries of 0x3f (32
+ bit) / 0x3f (64 bit)
+
+* All 64 bit vectors have a maximum number of entries of 0x1f (32
+ bit) / 0x1f (64 bit)
+
=== Blob conversions
(u8vector->blob U8VECTOR)
diff --git a/srfi-4.scm b/srfi-4.scm
index 8b3def2..9ef01fb 100644
--- a/srfi-4.scm
+++ b/srfi-4.scm
@@ -254,16 +254,16 @@ EOF
;;; Basic constructors:
-(let* ([ext-alloc
+(let* ((ext-alloc
(foreign-lambda* scheme-object ([int bytes])
"C_word *buf = (C_word *)C_malloc(bytes + sizeof(C_header));"
"if(buf == NULL) C_return(C_SCHEME_FALSE);"
"C_block_header(buf) = C_make_header(C_BYTEVECTOR_TYPE, bytes);"
- "C_return(buf);") ]
- [ext-free
+ "C_return(buf);") )
+ (ext-free
(foreign-lambda* void ([scheme-object bv])
- "C_free((void *)C_block_item(bv, 1));") ]
- [alloc
+ "C_free((void *)C_block_item(bv, 1));") )
+ (alloc
(lambda (loc len ext?)
(if ext?
(let ([bv (ext-alloc len)])
@@ -271,7 +271,11 @@ EOF
(##sys#error loc "not enough memory - cannot allocate
external number vector" len)) )
(let ([bv (##sys#allocate-vector len #t #f #t)]) ; this could be
made better...
(##core#inline "C_string_to_bytevector" bv)
- bv) ) ) ] )
+ bv) ) ) )
+ (maximum-8bit-entries (foreign-value "C_HEADER_SIZE_MASK"
unsigned-long))
+ (maximum-16bit-entries (##core#inline "C_fixnum_shift_right"
maximum-8bit-entries 1))
+ (maximum-32bit-entries (##core#inline "C_fixnum_shift_right"
maximum-8bit-entries 2))
+
Re: [Chicken-hackers] [PATCH] Raise error on construction of too large vectors/blobs
This patch feels lonely and awaits its decision about its faith... -- Who can (make) the muddy water (clear)? Let it be still, and it will gradually become clear. Who can secure the condition of rest? Let movement go on, and the condition of rest will gradually arise. -- Lao Tse. ___ Chicken-hackers mailing list Chicken-hackers@nongnu.org https://lists.nongnu.org/mailman/listinfo/chicken-hackers
Re: [Chicken-hackers] [PATCH] Bugfix for #791 and unpack flonums correctly for integer?
* Peter Bex [120304 17:11]: > Since I wrote the original patch, I didn't want to push it, > so someone else can have the opportunity to look at it. Since I also agree and I *wrote* *this* *patch* we are deadlocked. Attention! Robots need your help! Christian -- Who can (make) the muddy water (clear)? Let it be still, and it will gradually become clear. Who can secure the condition of rest? Let movement go on, and the condition of rest will gradually arise. -- Lao Tse. ___ Chicken-hackers mailing list Chicken-hackers@nongnu.org https://lists.nongnu.org/mailman/listinfo/chicken-hackers
Re: [Chicken-hackers] [PATCH] Clean out old cruft (debian dir, changelog files)
Thanks Peter, these went in, after I had to recreate the ChangeLog removal patch again... Cheers, Christian -- Who can (make) the muddy water (clear)? Let it be still, and it will gradually become clear. Who can secure the condition of rest? Let movement go on, and the condition of rest will gradually arise. -- Lao Tse. ___ Chicken-hackers mailing list Chicken-hackers@nongnu.org https://lists.nongnu.org/mailman/listinfo/chicken-hackers
Re: [Chicken-hackers] [PATCH] Fix numbers-string-conversion-tests compilation time
Thanks Peter! Looks good, pushed. -- Who can (make) the muddy water (clear)? Let it be still, and it will gradually become clear. Who can secure the condition of rest? Let movement go on, and the condition of rest will gradually arise. -- Lao Tse. ___ Chicken-hackers mailing list Chicken-hackers@nongnu.org https://lists.nongnu.org/mailman/listinfo/chicken-hackers
[Chicken-hackers] Clean versus pure in types.db
Hi all, I was looking through types.db and noticed that some procedures were marked "clean" and others "pure". If I understand correctly, the difference is that "clean" procedures may still have side-effects but will not mutate their input arguments (so pure is a more strict notion which implies everything clean implies, plus more) If that's correct, why are procedures like "length" and "list-tail" marked clean but not pure? (length (#(procedure #:clean #:enforce) length (list) fixnum) ; may loop ((null) '0) ((list) (##core#inline "C_u_i_length" #(1 (##sys#length (#(procedure #:clean #:enforce) ##sys#length (list) fixnum) ((null) '0) ((list) (##core#inline "C_u_i_length" #(1 (list-tail (forall (a) (#(procedure #:clean #:enforce) list-tail ((list-of a) fixnum) (list-of a Now, these are special-cased so maybe that's the reason? However, append, reverse and mem* are not special-cased and AFAICT should be pure but are all only marked "clean". Cheers, Peter -- http://sjamaan.ath.cx -- "The process of preparing programs for a digital computer is especially attractive, not only because it can be economically and scientifically rewarding, but also because it can be an aesthetic experience much like composing poetry or music." -- Donald Knuth ___ Chicken-hackers mailing list Chicken-hackers@nongnu.org https://lists.nongnu.org/mailman/listinfo/chicken-hackers
