Allow C functions to have more than 64 required arguments.

src/CHANGELOG

@@ -16,6 +16,8 @@ ECL 0.9i
 
 * Visible changes:
 
+ - Compiled functions can have more than 64 required arguments.
+
  - Many functions have got now the prefix "ecl_" so as to avoid namespace
    collisions with C/C++ code.
 

src/c/apply.d

@@ -978,6 +978,15 @@ APPLY_fixed(cl_narg n, cl_object (*fn)(), cl_object *x)
 		      x[43],x[44],x[45],x[46],x[47],x[48],x[49],
 		      x[50],x[51],x[52],x[53],x[54],x[55],x[56],
 		      x[57],x[58],x[59],x[60],x[61],x[62]);
+  case 64: return (*fn)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],
+		      x[8],x[9],x[10],x[11],x[12],x[13],x[14],
+		      x[15],x[16],x[17],x[18],x[19],x[20],x[21],
+		      x[22],x[23],x[24],x[25],x[26],x[27],x[28],
+		      x[29],x[30],x[31],x[32],x[33],x[34],x[35],
+		      x[36],x[37],x[38],x[39],x[40],x[41],x[42],
+		      x[43],x[44],x[45],x[46],x[47],x[48],x[49],
+		      x[50],x[51],x[52],x[53],x[54],x[55],x[56],
+		      x[57],x[58],x[59],x[60],x[61],x[62],x[63]);
   default:
 	  FEprogram_error("Too many arguments", 0);
   }

src/c/cfun.d

@@ -27,7 +27,7 @@ cl_make_cfun(void *c_function, cl_object name, cl_object cblock, int narg)
 	cf->cfun.name = name;
 	cf->cfun.block = cblock;
 	cf->cfun.narg = narg;
-	if (narg < 0 || narg >= C_ARGUMENTS_LIMIT)
+	if (narg < 0 || narg > C_ARGUMENTS_LIMIT)
 	    FEprogram_error("cl_make_cfun: function requires too many arguments.",0);
 	return(cf);
 }

src/cmp/cmpcall.lsp

@@ -48,7 +48,7 @@
 	  ((not (and (consp fun)
 		     (eq (first fun) 'FUNCTION)))
 	   (let ((l (length args)))
-	     (if (< (1- l) si::c-arguments-limit)
+	     (if (<= l si::c-arguments-limit)
 		 (make-c1form* 'FUNCALL :args (c1expr fun) (c1args* arguments))
 		 (c1expr `(with-stack
 			   ,@(loop for i in (rest args) collect `(stack-push ,i))

src/cmp/cmpeval.lsp

@@ -83,7 +83,7 @@
   (let ((fun (local-function-ref fname)))
     (when fun
       (let ((l (length args)))
-	(when (>= l si::c-arguments-limit)
+	(when (> l si::c-arguments-limit)
 	  (return-from c1call-local
 	    (c1expr `(with-stack
 		      ,@(loop for i in args collect `(stack-push ,i))
@@ -108,7 +108,7 @@
 
 (defun c1call-global (fname args)
   (let ((l (length args)))
-    (if (>= l si::c-arguments-limit)
+    (if (> l si::c-arguments-limit)
 	(c1expr `(with-stack
 		  ,@(loop for i in args collect `(stack-push ,i))
 		  (apply-from-stack ,l #',fname)))

src/cmp/cmplam.lsp

@@ -56,8 +56,16 @@
   (first (c1form-args form)))
 
 (defun fun-needs-narg (fun)
-  (or (eq (fun-closure fun) 'CLOSURE)
-      (/= (fun-minarg fun) (fun-maxarg fun))))
+  (not (fun-fixed-narg fun)))
+
+(defun fun-fixed-narg (fun)
+  "Returns true if the function has a fixed number of arguments and it is not a closure.
+The function thus belongs to the type of functions that cl_make_cfun accepts."
+  (let (narg)
+    (and (not (eq (fun-closure fun) 'CLOSURE))
+	 (= (fun-minarg fun) (setf narg (fun-maxarg fun)))
+	 (<= narg si::c-arguments-limit)
+	 narg)))
 
 (defun add-referred-variables-to-function (fun var-list)
   (setf (fun-referred-vars fun)
@@ -302,6 +310,18 @@
 	    (wt-nl "if(narg>" (+ nreq nopt) ") FEwrong_num_arguments_anonym();"))))
     (wt-nl "{"))
 
+  ;; If the number of required arguments exceeds the number of variables we
+  ;; want to pass on the C stack, we pass some of the arguments to the list
+  ;; of optionals, which will eventually get passed in the lisp stack.
+  (when (> nreq si::c-arguments-limit)
+    (setf nopt (+ nopt (- nreq si::c-arguments-limit))
+	  nreq si::c-arguments-limit)
+    (setf optionals (nconc (reduce #'nconc (mapcar #'(lambda (var) (list var *c1nil* NIL))
+						   (subseq requireds si::c-arguments-limit)))
+				  (rest optionals))
+	  required (subseq requireds 0 si::c-arguments-limit)
+	  varargs t))
+
   ;; For each variable, set its var-loc.
   ;; For optional and keyword parameters, and lexical variables which
   ;; can be unboxed, this will be a new LCL.

src/cmp/cmpspecial.lsp

@@ -135,16 +135,14 @@
 (defun wt-make-closure (fun &aux (cfun (fun-cfun fun)))
   (declare (type fun fun))
   (let* ((closure (fun-closure fun))
-	 (minarg (fun-minarg fun))
-	 (maxarg (fun-maxarg fun))
-	 (narg (if (= minarg maxarg) maxarg nil)))
+	 narg)
     (cond ((eq closure 'CLOSURE)
 	   (wt "cl_make_cclosure_va((void*)" cfun ","
 	       (environment-accessor fun)
 	       ",Cblock)"))
 	  ((eq closure 'LEXICAL)
 	   (baboon))
-	  (narg ; empty environment fixed number of args
+	  ((setf narg (fun-fixed-narg fun)) ; empty environment fixed number of args
 	   (wt "cl_make_cfun((void*)" cfun ",Cnil,Cblock," narg ")"))
 	  (t ; empty environment variable number of args
 	   (wt "cl_make_cfun_va((void*)" cfun ",Cnil,Cblock)")))))

src/h/config.h.in

@@ -98,13 +98,13 @@ typedef unsigned @CL_FIXNUM_TYPE@ cl_hashkey;
  *
  * In general, any of these limits must fit in a "signed int".
  */
-/*	Maximum number of function arguments 				*/
+/*	Maximum number of function arguments (arbitrary)		*/
 #define CALL_ARGUMENTS_LIMIT 65536
 
 /*	Maximum number of required arguments				*/
-#define LAMBDA_PARAMETERS_LIMIT 64
+#define LAMBDA_PARAMETERS_LIMIT CALL_ARGUMENTS_LIMIT
 
-/*	Numb. of args. which can be passed using the C stack		*/
+/*	Numb. of args. which will be passed using the C stack		*/
 /*	See cmplam.lsp if you change this value				*/
 #define C_ARGUMENTS_LIMIT 64