~ chicken-core (chicken-5) 3011d62e52d1e9c65b77f47d280c454aa2b432c5


commit 3011d62e52d1e9c65b77f47d280c454aa2b432c5
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: Mon Aug 31 05:51:32 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".
    
    Conflicts:
            c-backend.scm
            c-platform.scm
            compiler-namespace.scm
    
    Signed-off-by: felix <felix@call-with-current-continuation.org>

diff --git a/c-backend.scm b/c-backend.scm
index c9b07c4b..04e2781e 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -557,58 +557,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/eq? large-signatures (add1 n))))
-	     (gen #t)
-	     (for-each
-	      (lambda (s) 
-		(when (>= s small-parameter-limit)
-		  (set! large-signatures (lset-adjoin/eq? 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 61e81a8f..b2399eeb 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -39,8 +39,7 @@
      valid-compiler-options valid-compiler-options-with-argument
 
      ;; For consumption by c-backend *only*
-     target-include-file words-per-flonum
-     parameter-limit small-parameter-limit)
+     target-include-file words-per-flonum)
 
 (import chicken scheme
 	chicken.data-structures
@@ -78,8 +77,6 @@
 
 (define units-used-by-default '(library eval chicken-syntax))
 (define words-per-flonum 4)
-(define parameter-limit 1024)
-(define small-parameter-limit 128)
 
 (eq-inline-operator "C_eqp")
 (membership-test-operators
Trap