~ chicken-core (chicken-5) 5990b42e07725a3b877fc4b4aedd1818d522c8aa
commit 5990b42e07725a3b877fc4b4aedd1818d522c8aa
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Mon Mar 21 12:58:04 2011 +0100
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Mon Mar 21 12:58:04 2011 +0100
types.db fixes, manual update, enable specialization for -O3 and higher, removed warning in srfi-4
diff --git a/chicken.scm b/chicken.scm
index b84cf647..8b35e7cc 100644
--- a/chicken.scm
+++ b/chicken.scm
@@ -91,13 +91,13 @@
(set! options
(cons* 'optimize-leaf-routines 'inline 'inline-global
'unboxing 'local
- ;;XXX 'specialize
+ 'specialize
options) ) )
((4)
(set! options
(cons* 'optimize-leaf-routines 'inline 'inline-global
'unboxing
- ;;XXX 'specialize
+ 'specialize
'local 'unsafe
options) ) )
(else
@@ -106,7 +106,7 @@
(cons* 'disable-interrupts 'no-trace 'unsafe 'block
'optimize-leaf-routines 'lambda-lift
'no-lambda-info
- ;;XXX 'specialize
+ 'specialize
'inline 'inline-global 'unboxing
options) ) ) ) )
(loop (cdr rest)) ) )
diff --git a/manual/Using the compiler b/manual/Using the compiler
index ce8b3ed7..c42e25be 100644
--- a/manual/Using the compiler
+++ b/manual/Using the compiler
@@ -161,9 +161,9 @@ the source text should be read from standard input.
-optimize-level 0 is equivalent to -no-usual-integrations -no-compiler-syntax
-optimize-level 1 is equivalent to -optimize-leaf-routines
-optimize-level 2 is equivalent to -optimize-leaf-routines -inline -unboxing
- -optimize-level 3 is equivalent to -optimize-leaf-routines -local -inline -inline-global -unboxing
- -optimize-level 4 is equivalent to -optimize-leaf-routines -local -inline -inline-global -unboxing -unsafe
- -optimize-level 5 is equivalent to -optimize-leaf-routines -block -inline -inline-global -unsafe -unboxing -lambda-lift -disable-interrupts -no-trace -no-lambda-info
+ -optimize-level 3 is equivalent to -optimize-leaf-routines -local -inline -inline-global -unboxing -specialize
+ -optimize-level 4 is equivalent to -optimize-leaf-routines -local -inline -inline-global -unboxing -specialize -unsafe
+ -optimize-level 5 is equivalent to -optimize-leaf-routines -block -inline -inline-global -unboxing -specialize -unsafe -lambda-lift -disable-interrupts -no-trace -no-lambda-info
; -output-file FILENAME : Specifies the pathname of the generated C file. Default is {{FILENAME.c}}.
@@ -188,6 +188,8 @@ the source text should be read from standard input.
; -scrutinize : Enable simple flow-analysis to catch common type errors and argument/result mismatches. You can also use the {{scrutinize}} declaration to enable scrutiny.
+; -specialize : Enable simple flow-analysis for doing some type-directed optimizations.
+
; -static-extension NAME : similar to {{-require-extension NAME}}, but links extension statically (also applies for an explicit {{(require-extension NAME)}}).
; -types FILENAME : load additional type database from {{FILENAME}}. Type-definitions in {{FILENAME}} will override previous type-definitions.
diff --git a/scrutinizer.scm b/scrutinizer.scm
index b41d6945..ef712215 100755
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -674,7 +674,8 @@
(d " -> ~a" results)
results)))
(let ((rn (walk (first (node-subexpressions node)) '() '() #f #f)))
- (when (debugging 'x "specializations:")
+ (when (and (pair? specialization-statistics)
+ (debugging 'x "specializations:"))
(for-each
(lambda (ss)
(printf " ~a ~s~%" (cdr ss) (car ss)))
diff --git a/srfi-4.scm b/srfi-4.scm
index d4da259d..0d8ef56d 100644
--- a/srfi-4.scm
+++ b/srfi-4.scm
@@ -610,9 +610,9 @@ EOF
;;; Subvectors:
-(declare (hide subvector))
+(declare (hide subnvector))
-(define (subvector v t es from to loc)
+(define (subnvector v t es from to loc)
(##sys#check-structure v t loc)
(let* ([bv (##sys#slot v 1)]
[len (##sys#size bv)]
@@ -626,14 +626,14 @@ EOF
(##core#inline "C_copy_subvector" bv2 bv 0 (fx* from es) size2)
v) ) ) )
-(define (subu8vector v from to) (subvector v 'u8vector 1 from to 'subu8vector))
-(define (subu16vector v from to) (subvector v 'u16vector 2 from to 'subu16vector))
-(define (subu32vector v from to) (subvector v 'u32vector 4 from to 'subu32vector))
-(define (subs8vector v from to) (subvector v 's8vector 1 from to 'subs8vector))
-(define (subs16vector v from to) (subvector v 's16vector 2 from to 'subs16vector))
-(define (subs32vector v from to) (subvector v 's32vector 4 from to 'subs32vector))
-(define (subf32vector v from to) (subvector v 'f32vector 4 from to 'subf32vector))
-(define (subf64vector v from to) (subvector v 'f64vector 8 from to 'subf64vector))
+(define (subu8vector v from to) (subnvector v 'u8vector 1 from to 'subu8vector))
+(define (subu16vector v from to) (subnvector v 'u16vector 2 from to 'subu16vector))
+(define (subu32vector v from to) (subnvector v 'u32vector 4 from to 'subu32vector))
+(define (subs8vector v from to) (subnvector v 's8vector 1 from to 'subs8vector))
+(define (subs16vector v from to) (subnvector v 's16vector 2 from to 'subs16vector))
+(define (subs32vector v from to) (subnvector v 's32vector 4 from to 'subs32vector))
+(define (subf32vector v from to) (subnvector v 'f32vector 4 from to 'subf32vector))
+(define (subf64vector v from to) (subnvector v 'f64vector 8 from to 'subf64vector))
(define (write-u8vector v #!optional (port ##sys#standard-output) (from 0)
(to (u8vector-length v)))
diff --git a/types.db b/types.db
index fe4ed074..bfb3439a 100644
--- a/types.db
+++ b/types.db
@@ -144,18 +144,18 @@
((fixnum) (let ((#:tmp #(1))) '#t)))
(zero? (procedure zero? (number) boolean)
- ((fixnum) (eq? #(1) 0))
+ ((fixnum) (eq? #(1) '0))
((number) (##core#inline "C_u_i_zerop" #(1))))
(odd? (procedure odd? (number) boolean) ((fixnum) (fxodd? #(1))))
(even? (procedure even? (number) boolean) ((fixnum) (fxeven? #(1))))
(positive? (procedure positive? (number) boolean)
- ((fixnum) (##core#inline "C_fixnum_greaterp" #(1) 0))
+ ((fixnum) (##core#inline "C_fixnum_greaterp" #(1) '0))
((number) (##core#inline "C_u_i_positivep" #(1))))
(negative? (procedure negative? (number) boolean)
- ((fixnum) (##core#inline "C_fixnum_lessp" #(1) 0))
+ ((fixnum) (##core#inline "C_fixnum_lessp" #(1) '0))
((number) (##core#inline "C_u_i_negativep" #(1))))
(max (procedure max (#!rest number) number)
@@ -500,7 +500,7 @@
(abort (procedure abort (*) noreturn))
(add1 (procedure add1 (number) number)
- ((float) (##core#inline_allocate ("C_a_i_flonum_plus" 4) #(1) 1.0)))
+ ((float) (##core#inline_allocate ("C_a_i_flonum_plus" 4) #(1) '1.0)))
(argc+argv (procedure argc+argv () fixnum list))
(argv (procedure argv () list))
@@ -813,7 +813,7 @@
(sub1 (procedure sub1 (number) number)
((float) (##core#inline_allocate ("C_a_i_flonum_difference" 4)
- #(1) 1.0)))
+ #(1) '1.0)))
(subvector (procedure subvector (vector fixnum #!optional fixnum) vector))
(symbol-escape (procedure symbol-escape (#!optional *) *))
Trap