~ chicken-core (chicken-5) bd8610b67ef45018b5d282ec3c97ad9ff2d389dc

commit bd8610b67ef45018b5d282ec3c97ad9ff2d389dc
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Sun Aug 30 13:18:34 2015 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Sun Aug 30 22:40:53 2015 +0200

    Remove generation of large C_procN signatures.
    
    Previously, chicken.h contained C_procN prototypes for C functions up to
    small-parameter-limit, which is 128.  When a Scheme procedure would be
    defined that accepted more arguments than that, the compiler would
    "lazily" add a new prototype for the generated C function on-demand.
    
    Now, C_procN is not necessary anymore: every CPS procedure has two
    arguments; argcount and argvector.  The C_procN definitions are unused,
    so we can omit their code generation.
    
    This also removes the unused "parameter-limit" global variable along
    with "small-parameter-limit".
    
    Signed-off-by: felix <felix@call-with-current-continuation.org>

diff --git a/c-backend.scm b/c-backend.scm
index c8d37d06..41076027 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -545,58 +545,44 @@
 	    (gen "};")))))
   
     (define (prototypes)
-      (let ([large-signatures '()])
-	(gen #t)
-	(##sys#hash-table-for-each
-	 (lambda (id ll)
-	   (let* ([n (lambda-literal-argument-count ll)]
-		  [customizable (lambda-literal-customizable ll)] 
-		  [empty-closure (and customizable (zero? (lambda-literal-closure-size ll)))]
-		  [varlist (intersperse (make-variable-list (if empty-closure (sub1 n) n) "t") #\,)]
-		  [rest (lambda-literal-rest-argument ll)]
-		  [rest-mode (lambda-literal-rest-argument-mode ll)]
-		  [direct (lambda-literal-direct ll)] 
-		  [allocated (lambda-literal-allocated ll)] )
-	     (when (>= n small-parameter-limit)
-	       (set! large-signatures (lset-adjoin = large-signatures (add1 n))) )
-	     (gen #t)
-	     (for-each
-	      (lambda (s) 
-		(when (>= s small-parameter-limit)
-		  (set! large-signatures (lset-adjoin = large-signatures (add1 s))) ) )
-	      (lambda-literal-callee-signatures ll) )
-	     (cond [(not (eq? 'toplevel id))
-		    (gen "C_noret_decl(" id ")" #t)
-		    (gen "static ")
-		    (gen (if direct "C_word " "void "))
-		    (if customizable
-			(gen "C_fcall ")
-			(gen "C_ccall ") )
-		    (gen id) ]
-		   [else
-		    (let ((uname (if unit-name (string-append unit-name "_toplevel") "toplevel")))
-		      (gen "C_noret_decl(C_" uname ")" #t) ;XXX what's this for?
-		      (gen "C_externexport void C_ccall ")
-		      (gen "C_" uname) ) ] )
-	     (gen #\()
-	     (unless customizable (gen "C_word c,"))
-	     (when (and direct (not (zero? allocated)))
-	       (gen "C_word *a")
-	       (when (pair? varlist) (gen #\,)) )
-	     (if (or customizable direct)
-		 (apply gen varlist)
-		 (gen "C_word *av"))
-	     (gen #\))
-	     ;;(when customizable (gen " C_c_regparm"))
-	     (unless direct (gen " C_noret"))
-	     (gen #\;) ))
-	 lambda-table) 
-	(for-each
-	 (lambda (s)
-	   (gen #t "typedef void (*C_proc" s ")(C_word")
-	   (for-each gen (make-list s ",C_word"))
-	   (gen ") C_noret;") )
-	 large-signatures) ) )
+      (gen #t)
+      (##sys#hash-table-for-each
+       (lambda (id ll)
+	 (let* ((n (lambda-literal-argument-count ll))
+		(customizable (lambda-literal-customizable ll)) 
+		(empty-closure (and customizable (zero? (lambda-literal-closure-size ll))))
+		(varlist (intersperse (make-variable-list (if empty-closure (sub1 n) n) "t") #\,))
+		(rest (lambda-literal-rest-argument ll))
+		(rest-mode (lambda-literal-rest-argument-mode ll))
+		(direct (lambda-literal-direct ll)) 
+		(allocated (lambda-literal-allocated ll)) )
+	   (gen #t)
+	   (cond ((not (eq? 'toplevel id))
+		  (gen "C_noret_decl(" id ")" #t)
+		  (gen "static ")
+		  (gen (if direct "C_word " "void "))
+		  (if customizable
+		      (gen "C_fcall ")
+		      (gen "C_ccall ") )
+		  (gen id) )
+		 (else
+		  (let ((uname (if unit-name (string-append unit-name "_toplevel") "toplevel")))
+		    (gen "C_noret_decl(C_" uname ")" #t) ;XXX what's this for?
+		    (gen "C_externexport void C_ccall ")
+		    (gen "C_" uname) ) ) )
+	   (gen #\()
+	   (unless customizable (gen "C_word c,"))
+	   (when (and direct (not (zero? allocated)))
+	     (gen "C_word *a")
+	     (when (pair? varlist) (gen #\,)) )
+	   (if (or customizable direct)
+	       (apply gen varlist)
+	       (gen "C_word *av"))
+	   (gen #\))
+	   ;;(when customizable (gen " C_c_regparm"))
+	   (unless direct (gen " C_noret"))
+	   (gen #\;) ))
+       lambda-table) )
   
     (define (trampolines)
       (let ([ns '()]
diff --git a/c-platform.scm b/c-platform.scm
index cac81613..19c81681 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -66,8 +66,6 @@
 
 (define units-used-by-default '(library eval chicken-syntax)) 
 (define words-per-flonum 4)
-(define parameter-limit 1024)
-(define small-parameter-limit 128)
 (define unlikely-variables '(unquote unquote-splicing))
 
 (define eq-inline-operator "C_eqp")
diff --git a/compiler-namespace.scm b/compiler-namespace.scm
index 2806727b..dea9e4b0 100644
--- a/compiler-namespace.scm
+++ b/compiler-namespace.scm
@@ -216,7 +216,6 @@
  optimization-iterations
  original-program-size
  output
- parameter-limit
  pending-canonicalizations
  perform-closure-conversion
  perform-cps-conversion