From 91332cfaf2b0541e211ec4d5bd5b2ce07bcf3669 Mon Sep 17 00:00:00 2001
From: Peter Bex <address@hidden>
Date: Sun, 30 Aug 2015 13:18:34 +0200
Subject: [PATCH] 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
---
 c-backend.scm  | 90 +++++++++++++++++++++++++---------------------------------
 c-platform.scm |  5 +---
 2 files changed, 39 insertions(+), 56 deletions(-)

diff --git a/c-backend.scm b/c-backend.scm
index c9b07c4..04e2781 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 61e81a8..b2399ee 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
-- 
2.1.4