cmpc: get rid of another undocumented feature from FFI:C-INLINE

ffi:c-inline allowed for the xyntax @object (similar to the previous commit),
although only syntax "@(return x) = xxx" is specified in the documentation.
This commit is contained in:
Daniel Kochmański 2023-06-30 13:16:35 +02:00
parent f195f7d574
commit e49eafac22
5 changed files with 20 additions and 22 deletions

View file

@ -210,7 +210,7 @@ containing the whole rest of the given `string', if any."
HOST-NAME may also be an IP address in dotted quad notation or some
other weird stuff - see getaddrinfo(3) for details."
(multiple-value-bind (errno canonical-name addresses aliases)
(c-inline (host-name) (:cstring)
(c-inline (host-name :test #'equalp) (:cstring :object :object)
(values :int :object :object :object)
"
{
@ -247,7 +247,7 @@ other weird stuff - see getaddrinfo(3) for details."
ecl_aset(vector,1, ecl_make_fixnum( (ip>>16) & 0xFF));
ecl_aset(vector,2, ecl_make_fixnum( (ip>>8) & 0xFF));
ecl_aset(vector,3, ecl_make_fixnum( ip & 0xFF ));
addresses = cl_adjoin(4, vector, addresses, @':test, @'equalp);
addresses = cl_adjoin(4, vector, addresses, #1, #2);
if ( rp->ai_canonname != 0 ) {
cl_object alias = ecl_make_simple_base_string( rp->ai_canonname, -1 );
aliases = CONS(alias, aliases);

View file

@ -385,19 +385,16 @@
(case c
(#\@
(let ((object (read s)))
(cond ((and (consp object) (equal (first object) 'RETURN))
(unless (and (consp object) (eq (car object) 'RETURN))
(cmperr "Used @~s in C-INLINE form. Expected syntax is @(RETURN ...)." object))
(if (eq output-vars 'VALUES)
(cmperr "User @(RETURN ...) in a C-INLINE form with no output values")
(cmperr "Used @(RETURN ...) in a C-INLINE form with no output values.")
(let ((ndx (or (second object) 0))
(l (length output-vars)))
(if (< ndx l)
(wt (nth ndx output-vars))
(cmperr "Used @(RETURN ~D) in a C-INLINE form with ~D output values"
ndx l)))))
(t
(when (and (consp object) (eq (first object) 'QUOTE))
(setq object (second object)))
(wt (add-object object :permanent t))))))
(cmperr "Used @(RETURN ~D) in a C-INLINE form with ~D output values."
ndx l))))))
(#\#
(let* ((k (read-char s))
(next-char (peek-char nil s nil nil))

View file

@ -175,6 +175,6 @@
`(progn
(defun ,name ,(reverse arg-variables) ,@body)
(si:put-sysprop ',name :callback
(ffi:c-inline () () :object
,(format nil "ecl_make_foreign_data(@':pointer-void,0,(void*)~a)" c-name)
(ffi:c-inline (:pointer-void) (:object) :object
,(format nil "ecl_make_foreign_data(#0,0,(void*)~a)" c-name)
:one-liner t)))))))

View file

@ -477,12 +477,13 @@ translate ASCII and binary strings."
Converts a Lisp string to a foreign string. Memory should be freed
with free-foreign-object."
(let ((lisp-string (string string-designator)))
(c-inline (lisp-string) (t) t
(let ((lisp-string (string string-designator))
(foreign-type '(* :char)))
(c-inline (lisp-string foreign-type) (t t) t
"{
cl_object lisp_string = #0;
cl_index size = lisp_string->base_string.fillp;
cl_object output = ecl_allocate_foreign_data(@(* :char), size+1);
cl_object output = ecl_allocate_foreign_data(#1, size+1);
memcpy(output->foreign.data, lisp_string->base_string.self, size);
output->foreign.data[size] = '\\0';
@(return) = output;

View file

@ -843,7 +843,7 @@ Use special code 0 to cancel this operation.")
#-ecl-min
(defun decode-env-elt (env ndx)
(ffi:c-inline (env ndx) (:object :fixnum) :object
(ffi:c-inline (env ndx :utf-8) (:object :fixnum :object) :object
"
cl_object v = #0;
cl_index ndx = #1;
@ -851,7 +851,7 @@ Use special code 0 to cancel this operation.")
pinfo d = (pinfo)(v->vector.self.t[1]) + ndx;
cl_object name;
#ifdef ECL_UNICODE
name = ecl_decode_from_cstring(d->name,-1,@:utf-8);
name = ecl_decode_from_cstring(d->name,-1,#2);
if (!name)
#endif
name = ecl_make_constant_base_string(d->name,-1);