~ chicken-core (chicken-5) f1866224afcbeac28145c6153593171a36ce3cdb
commit f1866224afcbeac28145c6153593171a36ce3cdb
Merge: 69776d0c 197fb6f8
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Tue May 17 15:24:09 2011 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Tue May 17 15:24:09 2011 +0200
resolved conflicts
diff --cc c-platform.scm
index 01772426,79a29353..cf28da92
--- a/c-platform.scm
+++ b/c-platform.scm
@@@ -843,24 -824,23 +843,23 @@@
(rewrite 'floor 15 'flonum 'fixnum 'fpfloor #f)
(rewrite 'ceiling 15 'flonum 'fixnum 'fpceiling #f)
(rewrite 'truncate 15 'flonum 'fixnum 'fptruncate #f)
- (rewrite 'round 15 'flonum 'fixnum 'fpround #f)
-(rewrite 'fpsin 16 1 "C_a_i_flonum_sin" 'specialized words-per-flonum)
-(rewrite 'fpcos 16 1 "C_a_i_flonum_cos" 'specialized words-per-flonum)
-(rewrite 'fptan 16 1 "C_a_i_flonum_tan" 'specialized words-per-flonum)
-(rewrite 'fpasin 16 1 "C_a_i_flonum_asin" 'specialized words-per-flonum)
-(rewrite 'fpacos 16 1 "C_a_i_flonum_acos" 'specialized words-per-flonum)
-(rewrite 'fpatan 16 1 "C_a_i_flonum_atan" 'specialized words-per-flonum)
-(rewrite 'fpatan2 16 2 "C_a_i_flonum_atan2" 'specialized words-per-flonum)
-(rewrite 'fpexp 16 1 "C_a_i_flonum_exp" 'specialized words-per-flonum)
-(rewrite 'fpexpt 16 2 "C_a_i_flonum_expt" 'specialized words-per-flonum)
-(rewrite 'fplog 16 1 "C_a_i_flonum_log" 'specialized words-per-flonum)
-(rewrite 'fpsqrt 16 1 "C_a_i_flonum_sqrt" 'specialized words-per-flonum)
-(rewrite 'fpabs 16 1 "C_a_i_flonum_abs" 'specialized words-per-flonum)
-(rewrite 'fptruncate 16 1 "C_a_i_flonum_truncate" 'specialized words-per-flonum)
-(rewrite 'fpround 16 1 "C_a_i_flonum_round" 'specialized words-per-flonum)
-(rewrite 'fpceiling 16 1 "C_a_i_flonum_ceiling" 'specialized words-per-flonum)
-(rewrite 'fpfloor 16 1 "C_a_i_flonum_floor" 'specialized words-per-flonum)
+(rewrite 'fpsin 16 1 "C_a_i_flonum_sin" #f words-per-flonum)
+(rewrite 'fpcos 16 1 "C_a_i_flonum_cos" #f words-per-flonum)
+(rewrite 'fptan 16 1 "C_a_i_flonum_tan" #f words-per-flonum)
+(rewrite 'fpasin 16 1 "C_a_i_flonum_asin" #f words-per-flonum)
+(rewrite 'fpacos 16 1 "C_a_i_flonum_acos" #f words-per-flonum)
+(rewrite 'fpatan 16 1 "C_a_i_flonum_atan" #f words-per-flonum)
+(rewrite 'fpatan2 16 2 "C_a_i_flonum_atan2" #f words-per-flonum)
+(rewrite 'fpexp 16 1 "C_a_i_flonum_exp" #f words-per-flonum)
+(rewrite 'fpexpt 16 2 "C_a_i_flonum_expt" #f words-per-flonum)
+(rewrite 'fplog 16 1 "C_a_i_flonum_log" #f words-per-flonum)
+(rewrite 'fpsqrt 16 1 "C_a_i_flonum_sqrt" #f words-per-flonum)
+(rewrite 'fpabs 16 1 "C_a_i_flonum_abs" #f words-per-flonum)
+(rewrite 'fptruncate 16 1 "C_a_i_flonum_truncate" #f words-per-flonum)
- (rewrite 'fpround 16 1 "C_a_i_flonum_truncate" #f words-per-flonum)
- (rewrite 'fpceiling 16 1 "C_a_i_flonum_truncate" #f words-per-flonum)
- (rewrite 'fpround 16 1 "C_a_i_flonum_truncate" #f words-per-flonum)
++(rewrite 'fpround 16 1 "C_a_i_flonum_round" #f words-per-flonum)
++(rewrite 'fpceiling 16 1 "C_a_i_flonum_ceiling" #f words-per-flonum)
++(rewrite 'fpround 16 1 "C_a_i_flonum_floor" #f words-per-flonum)
(rewrite
'string->number 8
diff --cc manual/Using the compiler
index 284c0c3b,28f2373e..c5c8b2b7
--- a/manual/Using the compiler
+++ b/manual/Using the compiler
@@@ -155,12 -182,6 +155,10 @@@ the source text should be read from sta
; -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)}}).
-
+; -strict-types : Assume that the type of variables is not changed by assignments. This gives more type-information during specialization, but violating this assumption will result in unsafe and incorrectly behaving code.
+
; -types FILENAME : load additional type database from {{FILENAME}}. Type-definitions in {{FILENAME}} will override previous type-definitions.
; -compile-syntax : Makes macros also available at run-time. By default macros are not available at run-time.
diff --cc types.db
index 0c8b831a,cfbcce71..98a1a38d
--- a/types.db
+++ b/types.db
@@@ -1126,49 -598,34 +1126,44 @@@
;; lolevel
-(address->pointer (procedure address->pointer (fixnum) pointer))
+(address->pointer (procedure! address->pointer (fixnum) pointer)
+ ((fixnum) (##sys#address->pointer #(1))))
+
(align-to-word (procedure align-to-word (*) *))
- (allocate (procedure! allocate (fixnum) pointer))
-(allocate (procedure allocate (fixnum) (or boolean pointer)))
-(block-ref (procedure block-ref (* fixnum) *))
-(block-set! (procedure block-set! (* fixnum *) *))
-(clear-unbound-variable-value! (procedure clear-unbound-variable-value! () undefined))
-(extend-procedure (procedure extend-procedure (procedure *) procedure))
++(allocate (procedure! allocate (fixnum) (or boolean pointer)))
+(block-ref (procedure! block-ref (* fixnum) *))
+(block-set! (procedure! block-set! (* fixnum *) *))
+(extend-procedure (procedure! extend-procedure (procedure *) procedure))
(extended-procedure? (procedure extended-procedure? (*) boolean))
-(free (procedure free (pointer) *))
-(global-bound? deprecated)
-(global-make-unbound! deprecated)
-(global-ref deprecated)
-(global-set! deprecated)
-(invalid-procedure-call-handler (procedure invalid-procedure-call-handler () procedure))
-(locative->object (procedure locative->object (locative) *))
-(locative-ref (procedure locative-ref (locative) *))
-(locative-set! (procedure locative-set! (locative *) *))
+(free (procedure! free (pointer) *))
+(locative->object (procedure! locative->object (locative) *))
+(locative-ref (procedure! locative-ref (locative) *))
+(locative-set! (procedure! locative-set! (locative *) *))
(locative? (procedure locative? (*) boolean))
-(make-locative (procedure make-locative (* #!optional fixnum) locative))
-(make-pointer-vector (procedure make-pointer-vector (fixnum #!optional pointer) pointer-vector))
+(make-locative (procedure! make-locative (* #!optional fixnum) locative))
+(make-pointer-vector (procedure! make-pointer-vector (fixnum #!optional pointer) pointer-vector))
(make-record-instance (procedure make-record-instance (* #!rest) *))
-(make-weak-locative (procedure make-weak-locative (* #!optional fixnum) locative))
-(move-memory! (procedure move-memory! (* * #!optional fixnum fixnum fixnum) *))
-(mutate-procedure (procedure mutate-procedure (procedure procedure) procedure))
+(make-weak-locative (procedure! make-weak-locative (* #!optional fixnum) locative))
+
+(move-memory! (procedure! move-memory! (* * #!optional fixnum fixnum fixnum) *)
+ ((pointer pointer fixnum)
+ (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) '0 '0))
+ ((pointer pointer fixnum fixnum)
+ (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) '0 #(4)))
+ ((pointer pointer fixnum fixnum fixnum)
+ (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) #(5) #(4)))
+ ((locative locative fixnum)
+ (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) '0 '0))
+ ((locative locative fixnum fixnum)
+ (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) '0 #(4)))
+ ((locative locative fixnum fixnum fixnum)
+ (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) #(5) #(4))))
+
+(mutate-procedure (procedure! mutate-procedure (procedure procedure) procedure))
- (null-pointer (procedure null-pointer () pointer))
-
- (null-pointer? (procedure! null-pointer? (pointer) boolean)
- ((pointer) (##core#inline "C_null_pointerp" #(1))))
-
+ (null-pointer deprecated)
+ (null-pointer? deprecated)
(number-of-bytes (procedure number-of-bytes (*) fixnum))
-
-(number-of-slots (procedure number-of-slots (*) fixnum))
+(number-of-slots (procedure number-of-slots (*) fixnum)) ;XXX
-
(object->pointer (procedure object->pointer (*) *))
(object-become! (procedure object-become! (list) *))
(object-copy (procedure object-copy (*) *))
Trap