>From 46b50413de1221fbf542608f1b923d9b104783d8 Mon Sep 17 00:00:00 2001
From: Peter Bex
Date: Sun, 23 Sep 2012 20:38:34 +0200
Subject: [PATCH 1/2] Remove some unused procedures and old "binary
compatibility" stuff:
- ##sys#double->number
- find-lambda-container
- explicitly-consed list
- contains?
- ##sys#call-with-cthulhu
- C_exact_to_inexact
- C_string_to_number
- C_call_with_cthulhu
---
c-platform.scm | 3 +-
chicken.h | 3 --
compiler-namespace.scm | 1 -
compiler.scm | 11 +---------
library.scm | 2 -
runtime.c | 52 +-----------------------------------------------
support.scm | 6 -----
7 files changed, 3 insertions(+), 75 deletions(-)
diff --git a/c-platform.scm b/c-platform.scm
index 32f9b88..4423cf6 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -184,7 +184,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?) )
@@ -966,7 +966,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 8293f07..90a1475 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1716,9 +1716,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 */
@@ -1746,7 +1744,6 @@ C_fctexport void C_ccall C_set_dlopen_flags(C_word c, C_word closure, C_word k,
C_fctexport void C_ccall C_dload(C_word c, C_word closure, C_word k, C_word name, C_word entry) C_noret;
C_fctexport void C_ccall C_become(C_word c, C_word closure, C_word k, C_word table) C_noret;
C_fctexport void C_ccall C_locative_ref(C_word c, C_word closure, C_word k, C_word loc) C_noret;
-C_fctexport void C_ccall C_call_with_cthulhu(C_word c, C_word self, C_word k, C_word proc) C_noret;
C_fctexport void C_ccall C_copy_closure(C_word c, C_word closure, C_word k, C_word proc) C_noret;
C_fctexport void C_ccall C_dump_heap_state(C_word x, C_word closure, C_word k) C_noret;
C_fctexport void C_ccall C_filter_heap_objects(C_word x, C_word closure, C_word k, C_word func,
diff --git a/compiler-namespace.scm b/compiler-namespace.scm
index 41dbaf1..ca873c9 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 94d178d..4448ac7 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -1806,8 +1806,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)) )
@@ -1962,13 +1961,6 @@
(define (quick-put! plist prop val)
(set-cdr! plist (alist-cons prop val (cdr plist))) )
- ;; Return true if directly or indirectly contains any of :
- (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)
@@ -2123,7 +2115,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/library.scm b/library.scm
index bb30f39..fb922d4 100644
--- a/library.scm
+++ b/library.scm
@@ -907,7 +907,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))
@@ -1544,7 +1543,6 @@ EOF
(define apply (##core#primitive "C_apply"))
(define ##sys#call-with-current-continuation (##core#primitive "C_call_cc"))
(define (##sys#call-with-direct-continuation k) (##core#app k (##core#inline "C_direct_continuation" #f)))
-(define ##sys#call-with-cthulhu (##core#primitive "C_call_with_cthulhu"))
(define (##sys#direct-return dk x) (##core#inline "C_direct_return" dk x))
(define values (##core#primitive "C_values"))
(define ##sys#call-with-values (##core#primitive "C_call_with_values"))
diff --git a/runtime.c b/runtime.c
index 2673d81..43aa5b0 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);
@@ -7159,23 +7157,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)
{
@@ -7403,26 +7384,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;
@@ -8628,17 +8589,6 @@ static void copy_closure_2(void *dummy)
}
-/* Creating black holes: */
-
-void C_call_with_cthulhu(C_word c, C_word self, C_word k, C_word proc)
-{
- C_word *a = C_alloc(3);
-
- k = C_closure(&a, 1, (C_word)termination_continuation);
- C_apply(4, C_SCHEME_UNDEFINED, k, proc, C_SCHEME_END_OF_LIST);
-}
-
-
/* fixnum arithmetic with overflow detection (from "Hacker's Delight" by Hank Warren)
These routines return #f if the operation failed due to overflow.
*/
diff --git a/support.scm b/support.scm
index 0ed4839..7fab02b 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)
--
1.7.9.1