cmp: complain when the number of arguments of an exported function is not known

When we don't know how many arguments an exported function takes, we
can't create a correct declaration for the C function in the .eclh
file. To avoid having too many proclamations, we extract this
information from symbols_list.h for ECL core functions defined in
Lisp.
This commit is contained in:
Marius Gerbershagen 2019-11-01 13:52:48 +01:00 committed by Daniel Kochmański
parent a2319d3150
commit bc9f75871e
2 changed files with 23 additions and 11 deletions

View file

@ -138,16 +138,6 @@
;; Call to a function whose C language function name is known,
;; either because it has been proclaimed so, or because it belongs
;; to the runtime.
(when (policy-use-direct-C-call)
(let ((fd (si:get-sysprop fname 'Lfun)))
(when fd
(multiple-value-bind (minarg maxarg) (get-proclaimed-narg fname)
(return-from call-global-loc
(call-exported-function-loc
fname args fd minarg maxarg
(si::mangle-name fname)
return-type))))))
(multiple-value-bind (found fd minarg maxarg)
(si::mangle-name fname t)
(when found
@ -155,6 +145,28 @@
(call-exported-function-loc fname args fd minarg maxarg t
return-type))))
(when (policy-use-direct-C-call)
(let ((fd (si:get-sysprop fname 'Lfun)))
(when fd
(multiple-value-bind (minarg maxarg found) (get-proclaimed-narg fname)
#+ecl-min
(unless found
;; Without knowing the number of arguments we cannot call
;; the C function. When compiling ECL itself, we get this
;; information through si::mangle-name from symbols_list.h
;; for core functions defined in Lisp code.
(let (ignored)
(multiple-value-setq (found ignored minarg maxarg)
(si::mangle-name fname))))
(unless found
(cmperr "Can not call the function ~A using its exported C name ~A because its function type has not been proclaimed"
fname fd))
(return-from call-global-loc
(call-exported-function-loc
fname args fd minarg maxarg
(si::mangle-name fname)
return-type))))))
(call-unknown-global-loc fname nil args))
(defun call-loc (fname fun args type)

View file

@ -105,7 +105,7 @@
and maxarg = 0
and in-optionals = nil
do (cond ((member type '(* &rest &key &allow-other-keys) :test #'eq)
(return (values minarg call-arguments-limit)))
(return (values minarg call-arguments-limit found)))
((eq type '&optional)
(setf in-optionals t maxarg minarg))
(in-optionals