>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