~ chicken-core (chicken-5) 6e10dfb17175faa307a2a7230cf705c987af85c5
commit 6e10dfb17175faa307a2a7230cf705c987af85c5
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Thu Oct 4 23:33:27 2012 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Thu Oct 4 23:33:27 2012 +0200
Remove some unused procedures and old "binary compatibility" stuff:
- ##sys#double->number
- find-lambda-container
- explicitly-consed list
- contains?
- C_exact_to_inexact
- C_string_to_number
Originally by Peter Bex, changes made by felix:
* "##sys#call-with-cthulhu" was kept to avoid messing with powers that one
is not to trifle with
* bumped binary compatibility version to 7
Signed-off-by: felix <felix@call-with-current-continuation.org>
diff --git a/c-platform.scm b/c-platform.scm
index facdbe78..c64db6ce 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -181,7 +181,7 @@
##sys#foreign-char-argument ##sys#foreign-fixnum-argument ##sys#foreign-flonum-argument
##sys#foreign-block-argument ##sys#foreign-struct-wrapper-argument
##sys#foreign-string-argument ##sys#foreign-pointer-argument ##sys#void
- ##sys#foreign-integer-argument ##sys#foreign-unsigned-integer-argument ##sys#double->number
+ ##sys#foreign-integer-argument ##sys#foreign-unsigned-integer-argument
##sys#peek-fixnum ##sys#setislot ##sys#poke-integer ##sys#permanent? ##sys#values ##sys#poke-double
##sys#intern-symbol ##sys#make-symbol ##sys#null-pointer? ##sys#peek-byte
##sys#file-exists?) )
@@ -963,7 +963,6 @@
(rewrite '##sys#setislot 17 3 "C_i_set_i_slot")
(rewrite '##sys#poke-integer 17 3 "C_poke_integer")
(rewrite '##sys#poke-double 17 3 "C_poke_double")
-(rewrite '##sys#double->number 17 1 "C_double_to_number")
(rewrite 'string=? 17 2 "C_i_string_equal_p" "C_u_i_string_equal_p")
(rewrite 'string-ci=? 17 2 "C_i_string_ci_equal_p")
(rewrite '##sys#fudge 17 1 "C_fudge")
diff --git a/chicken.h b/chicken.h
index 8a6fcba4..5ba5722b 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1704,9 +1704,7 @@ C_fctexport void C_ccall C_allocate_vector(C_word c, C_word closure, C_word k, C
C_fctexport void C_ccall C_string_to_symbol(C_word c, C_word closure, C_word k, C_word string) C_noret;
C_fctexport void C_ccall C_build_symbol(C_word c, C_word closure, C_word k, C_word string) C_noret;
C_fctexport void C_ccall C_flonum_fraction(C_word c, C_word closure, C_word k, C_word n) C_noret;
-C_fctexport void C_ccall C_exact_to_inexact(C_word c, C_word closure, C_word k, C_word n) C_noret; /*XXX left for binary compatibility */
C_fctexport void C_ccall C_quotient(C_word c, C_word closure, C_word k, C_word n1, C_word n2) C_noret;
-C_fctexport void C_ccall C_string_to_number(C_word c, C_word closure, C_word k, C_word str, ...) C_noret; /*XXX left for binary compatibility */
C_fctexport void C_ccall C_number_to_string(C_word c, C_word closure, C_word k, C_word num, ...) C_noret;
C_fctexport void C_ccall C_fixnum_to_string(C_word c, C_word closure, C_word k, C_word num) C_noret;
C_fctexport void C_ccall C_get_argv(C_word c, C_word closure, C_word k) C_noret; /* OBSOLETE */
diff --git a/compiler-namespace.scm b/compiler-namespace.scm
index 41dbaf12..ca873c90 100644
--- a/compiler-namespace.scm
+++ b/compiler-namespace.scm
@@ -139,7 +139,6 @@
final-foreign-type
find-early-refs
find-inlining-candidates
- find-lambda-container
finish-foreign-result
first-analysis
fold-boolean
diff --git a/compiler.scm b/compiler.scm
index 2927b1ff..64624bd0 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -1820,8 +1820,7 @@
(define (analyze-expression node)
;; Avoid crowded hash tables by using previous run's size as heuristic
(let* ((db-size (fx* (fxmax current-analysis-database-size 1) 3))
- (db (make-vector db-size '()))
- (explicitly-consed '()) )
+ (db (make-vector db-size '())))
(define (grow n)
(set! current-program-size (+ current-program-size n)) )
@@ -1976,13 +1975,6 @@
(define (quick-put! plist prop val)
(set-cdr! plist (alist-cons prop val (cdr plist))) )
- ;; Return true if <id> directly or indirectly contains any of <other-ids>:
- (define (contains? id other-ids)
- (or (memq id other-ids)
- (let ((clist (get db id 'contains)))
- (and clist
- (any (lambda (id2) (contains? id2 other-ids)) clist) ) ) ) )
-
;; Walk toplevel expression-node:
(debugging 'p "analysis traversal phase...")
(set! current-program-size 0)
@@ -2137,7 +2129,6 @@
(cond [(and has (not (rassoc sym callback-names eq?)))
(put! db (first lparams) 'has-unused-parameters #t) ]
[rest
- (set! explicitly-consed (cons rest explicitly-consed))
(put! db (first lparams) 'explicit-rest #t) ] ) ) ) ) ) ) ) )
;; Make 'removable, if it has no references and is not assigned to, and if it
diff --git a/defaults.make b/defaults.make
index a16e5a52..daa71707 100644
--- a/defaults.make
+++ b/defaults.make
@@ -27,7 +27,7 @@
# basic parameters
-BINARYVERSION = 6
+BINARYVERSION = 7
STACKDIRECTION ?= 1
CROSS_CHICKEN ?= 0
diff --git a/library.scm b/library.scm
index 0ee3378a..faa2457e 100644
--- a/library.scm
+++ b/library.scm
@@ -908,7 +908,6 @@ EOF
(define (##sys#fits-in-int? n) (##core#inline "C_fits_in_int_p" n))
(define (##sys#fits-in-unsigned-int? n) (##core#inline "C_fits_in_unsigned_int_p" n))
(define (##sys#flonum-in-fixnum-range? n) (##core#inline "C_flonum_in_fixnum_range_p" n))
-(define (##sys#double->number n) (##core#inline "C_double_to_number" n))
(define (zero? n) (##core#inline "C_i_zerop" n))
(define (positive? n) (##core#inline "C_i_positivep" n))
(define (negative? n) (##core#inline "C_i_negativep" n))
diff --git a/runtime.c b/runtime.c
index c03294bd..e4f56cfb 100644
--- a/runtime.c
+++ b/runtime.c
@@ -727,7 +727,7 @@ int CHICKEN_initialize(int heap, int stack, int symbols, void *toplevel)
static C_PTABLE_ENTRY *create_initial_ptable()
{
/* IMPORTANT: hardcoded table size - this must match the number of C_pte calls! */
- C_PTABLE_ENTRY *pt = (C_PTABLE_ENTRY *)C_malloc(sizeof(C_PTABLE_ENTRY) * 60);
+ C_PTABLE_ENTRY *pt = (C_PTABLE_ENTRY *)C_malloc(sizeof(C_PTABLE_ENTRY) * 57);
int i = 0;
if(pt == NULL)
@@ -765,7 +765,6 @@ static C_PTABLE_ENTRY *create_initial_ptable()
C_pte(C_quotient);
C_pte(C_flonum_fraction);
C_pte(C_expt);
- C_pte(C_string_to_number);
C_pte(C_number_to_string);
C_pte(C_make_symbol);
C_pte(C_string_to_symbol);
@@ -787,7 +786,6 @@ static C_PTABLE_ENTRY *create_initial_ptable()
C_pte(C_context_switch);
C_pte(C_register_finalizer);
C_pte(C_locative_ref);
- C_pte(C_call_with_cthulhu);
C_pte(C_copy_closure);
C_pte(C_dump_heap_state);
C_pte(C_filter_heap_objects);
@@ -7147,23 +7145,6 @@ void C_ccall C_flonum_fraction(C_word c, C_word closure, C_word k, C_word n)
}
-/* XXX left for binary compatibility */
-void C_ccall C_exact_to_inexact(C_word c, C_word closure, C_word k, C_word n)
-{
- C_alloc_flonum;
-
- if(c != 3) C_bad_argc(c, 3);
-
- if(n & C_FIXNUM_BIT) {
- C_kontinue_flonum(k, (double)C_unfix(n));
- }
- else if(C_immediatep(n) || C_block_header(n) != C_FLONUM_TAG)
- barf(C_BAD_ARGUMENT_TYPE_ERROR, "exact->inexact", n);
-
- C_kontinue(k, n);
-}
-
-
C_regparm C_word C_fcall
C_a_i_exact_to_inexact(C_word **a, int c, C_word n)
{
@@ -7391,26 +7372,6 @@ C_a_i_string_to_number(C_word **a, int c, C_word str, C_word radix0)
}
-/* only left for backwards-compatibility */
-void C_ccall
-C_string_to_number(C_word c, C_word closure, C_word k, C_word str, ...)
-{
- va_list va;
- C_word data[ C_SIZEOF_FLONUM + 2 ]; /* alignment */
- C_word *a = data;
- C_word radix = C_fix(10);
-
- if(c == 4) {
- va_start(va, str);
- radix = va_arg(va, C_word);
- va_end(va);
- }
- else if(c != 3) C_bad_argc(c, 3);
-
- C_kontinue(k, C_a_i_string_to_number(&a, 2, str, radix));
-}
-
-
static int from_n_nary(C_char *str, int base, double *r)
{
double n = 0;
diff --git a/support.scm b/support.scm
index 0ed4839a..7fab02bd 100644
--- a/support.scm
+++ b/support.scm
@@ -421,12 +421,6 @@
=> (lambda (a) (values (car lst) (cdr a))) )
(else (values name #f)) ) ) )
-(define (find-lambda-container id cid db)
- (let loop ([id id])
- (or (eq? id cid)
- (let ([c (get db id 'contained-in)])
- (and c (loop c)) ) ) ) )
-
(define (display-line-number-database)
(##sys#hash-table-for-each
(lambda (key val)
Trap