From c44f7bf9b40d7f8cf7585d312c818b27798e30dc Mon Sep 17 00:00:00 2001 From: jgarcia Date: Thu, 29 Jun 2006 15:57:52 +0000 Subject: [PATCH] Allow C functions to have more than 64 required arguments. --- src/CHANGELOG | 2 ++ src/c/apply.d | 9 +++++++++ src/c/cfun.d | 2 +- src/cmp/cmpcall.lsp | 2 +- src/cmp/cmpeval.lsp | 4 ++-- src/cmp/cmplam.lsp | 24 ++++++++++++++++++++++-- src/cmp/cmpspecial.lsp | 6 ++---- src/h/config.h.in | 6 +++--- 8 files changed, 42 insertions(+), 13 deletions(-) diff --git a/src/CHANGELOG b/src/CHANGELOG index 69f1eef4f..16671ea04 100644 --- a/src/CHANGELOG +++ b/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. diff --git a/src/c/apply.d b/src/c/apply.d index fbba51f49..f1ac65fc9 100644 --- a/src/c/apply.d +++ b/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); } diff --git a/src/c/cfun.d b/src/c/cfun.d index c46a96291..41f3956c9 100644 --- a/src/c/cfun.d +++ b/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); } diff --git a/src/cmp/cmpcall.lsp b/src/cmp/cmpcall.lsp index a30d0b24a..80c241254 100644 --- a/src/cmp/cmpcall.lsp +++ b/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)) diff --git a/src/cmp/cmpeval.lsp b/src/cmp/cmpeval.lsp index 6725ddce1..5f119bc9c 100644 --- a/src/cmp/cmpeval.lsp +++ b/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))) diff --git a/src/cmp/cmplam.lsp b/src/cmp/cmplam.lsp index 99ec524cc..f3e624fe9 100644 --- a/src/cmp/cmplam.lsp +++ b/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. diff --git a/src/cmp/cmpspecial.lsp b/src/cmp/cmpspecial.lsp index 714874dd8..fb37c0463 100644 --- a/src/cmp/cmpspecial.lsp +++ b/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)"))))) diff --git a/src/h/config.h.in b/src/h/config.h.in index 5b24ddd28..5a31e4857 100644 --- a/src/h/config.h.in +++ b/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