diff --git a/docs/fli-notes.md b/docs/fli-notes.md index ddd571e179..69a86325a5 100644 --- a/docs/fli-notes.md +++ b/docs/fli-notes.md @@ -48,6 +48,7 @@ A quote of [Dr. Christian E. Schafmeister][], [drmeister][] on Github, the ceato * II.1 [Source Code](#id-ii.1) * II.1.1 [Source Code Files](#id-ii.1.1) * II.2 [Source Code Rules & Conventions](#id-ii.2) + * II.3 [Calling Variadic Foreign Functions](#id-ii.3) * * * * * @@ -153,3 +154,61 @@ Integration with the main development branch of [drmeister's repository, branch The following rules and conventions have been used to implement the FLI: 1. All FLI Lisp functions and macros are prefixed with a % sign - indicating that these macros and functions are meant to not be used directly by a user of the FLI, except when implementing low level access to Clasp's FLI on purpose. + +* * * * * + +
+## II.3 Calling Variadic Foreign Functions ## + +A variadic callee -- `printf`, `open`, `fcntl`, `shm_open` -- must be called through a +*variadic* function type that names how many of its parameters are fixed. Calling it through +an ordinary function type is undefined behaviour in C, and the two are not interchangeable in +practice: + +* On **x86-64 SysV** variadic arguments are passed in the same registers as fixed ones, so the + mistake is invisible. +* On **Darwin arm64** variadic arguments are passed on the **stack**. A call lowered as + non-variadic leaves them in registers, the callee reads an unwritten stack slot, and every + variadic argument arrives as **zero**. + +The usual symptom is a mode or flag that silently does nothing. `shm_open(name, flags, 0600)` +creates its object with `st_mode` `0`, which cannot then be reopened; `fcntl(fd, F_SETFD, +FD_CLOEXEC)` returns success without setting the flag. + +### API + + (clasp-ffi:%foreign-funcall-varargs NAME FIXED-COUNT &rest ARGUMENTS) + (clasp-ffi:%foreign-funcall-pointer-varargs PTR FIXED-COUNT &rest ARGUMENTS) + +`ARGUMENTS` alternate type and value and end with the return type, exactly as for +`%FOREIGN-FUNCALL`. `FIXED-COUNT` is how many of them are the callee's **fixed** parameters; +the rest are variadic. It must be a literal integer, because it selects the fixed prefix when +the function type is built at compile time, and it is validated at macroexpansion. + + ;; int fcntl(int fd, int cmd, ...); -- two fixed parameters + (clasp-ffi:%foreign-funcall-varargs "fcntl" 2 :int fd :int f-setfd :int fd-cloexec :int) + +`%FOREIGN-FUNCALL` is unchanged and still builds a non-variadic type, which is correct for the +overwhelming majority of callees. Only reach for the variadic forms when the C declaration has +an ellipsis. + +### Implementation + +`CMP:FUNCTION-TYPE-CREATE-ON-THE-FLY` accepts the foreign-type list in two shapes: + + (return-type (arg-types ...)) ; non-variadic + (return-type (arg-types ...) fixed-count) ; variadic + +The third element is optional, so the representation is backward compatible: the BIR +instruction, the translator and the foreign-caller cache all treat the signature as opaque data +and needed no change. + +### CFFI + +CFFI already carries the fixed/variadic split down to the backend, and falls back to appending +the two lists -- discarding the distinction -- when the backend does not define +`%FOREIGN-FUNCALL-VARARGS`. Clasp's backend defines it, so + + (cffi:foreign-funcall-varargs "shm_open" (:string name :int flags) :int #o600 :int) + +passes the mode correctly. diff --git a/src/lisp/kernel/cmp/codegen-special-form.lisp b/src/lisp/kernel/cmp/codegen-special-form.lisp index 266d560141..7ca90b2ed2 100644 --- a/src/lisp/kernel/cmp/codegen-special-form.lisp +++ b/src/lisp/kernel/cmp/codegen-special-form.lisp @@ -110,9 +110,16 @@ ;;; FOREIGN-CALL, FOREIGN-CALL-POINTER +;;; FOREIGN-TYPES is (return-type (arg-types...)) or, for a variadic callee, +;;; (return-type (arg-types...) fixed-count). The distinction is not cosmetic: on +;;; Darwin arm64 variadic arguments are passed on the stack, so lowering a +;;; variadic call as non-variadic puts them in registers and the callee reads +;;; whatever the stack happened to hold -- usually zero. (defun function-type-create-on-the-fly (foreign-types) - (let ((arg-types (mapcar (lambda (type) - (clasp-ffi::safe-translator-type type)) - (second foreign-types))) - (varargs nil)) + (let* ((all-arg-types (mapcar (lambda (type) + (clasp-ffi::safe-translator-type type)) + (second foreign-types))) + (fixed-count (third foreign-types)) + (varargs (and fixed-count t)) + (arg-types (if varargs (subseq all-arg-types 0 fixed-count) all-arg-types))) (llvm-sys:function-type-get (clasp-ffi::safe-translator-type (first foreign-types)) arg-types varargs))) diff --git a/src/lisp/kernel/lsp/fli.lisp b/src/lisp/kernel/lsp/fli.lisp index 9c6a0a380a..cdff1f8cde 100644 --- a/src/lisp/kernel/lsp/fli.lisp +++ b/src/lisp/kernel/lsp/fli.lisp @@ -218,6 +218,16 @@ (right '() (if (endp (rest list)) right (list* (second list) right)))) ((endp list) (list (nreverse left) (nreverse right))))) +(defun check-fixed-count (fixed-count arg-types context) + "Signal at macroexpansion if FIXED-COUNT cannot name a prefix of ARG-TYPES." + (unless (integerp fixed-count) + (error "~a: the fixed-argument count must be a literal integer, got ~s.~@ + It selects the callee's fixed parameters at compile time and cannot be computed at runtime." + context fixed-count)) + (unless (<= 0 fixed-count (length arg-types)) + (error "~a: fixed-argument count ~s is out of range; the call passes ~s argument~:p." + context fixed-count (length arg-types)))) + (defun extract-signature (arguments) "Converts (:float 16.0 :int 3 :float) -> (values '(:float (:float :int)) (16.0 3))" (let* ((types-args (clasp-ffi::split-list arguments)) @@ -238,6 +248,32 @@ (extract-signature arguments) `(core:foreign-call-pointer ,signature (ensure-core-pointer ,ptr "%foreign-funcall-pointer" ,ptr) ,@args))) +;;; A variadic callee must be called through a variadic function type, naming how +;;; many arguments are fixed. Passing everything as fixed works by accident on +;;; x86-64 SysV, where variadic arguments use the same registers, and fails on +;;; Darwin arm64, where they are passed on the stack: the callee then reads an +;;; unwritten slot, so the argument arrives as zero. +(defmacro %foreign-funcall-varargs (name fixed-count &rest arguments) + "Call the variadic foreign function NAME. ARGUMENTS alternate type and value and +end with the return type, as for %FOREIGN-FUNCALL; the first FIXED-COUNT of them +are the callee's fixed parameters and the rest are variadic." + (multiple-value-bind (signature args) + (extract-signature arguments) + (check-fixed-count fixed-count (second signature) '%FOREIGN-FUNCALL-VARARGS) + `(core:foreign-call-pointer ,(append signature (list fixed-count)) + (ensure-core-pointer (core:dlsym :rtld-default ,name) + "%foreign-funcall-varargs" ,name) + ,@args))) + +(defmacro %foreign-funcall-pointer-varargs (ptr fixed-count &rest arguments) + "As %FOREIGN-FUNCALL-VARARGS, but calls the function at PTR." + (multiple-value-bind (signature args) + (extract-signature arguments) + (check-fixed-count fixed-count (second signature) '%FOREIGN-FUNCALL-POINTER-VARARGS) + `(core:foreign-call-pointer ,(append signature (list fixed-count)) + (ensure-core-pointer ,ptr "%foreign-funcall-pointer-varargs" ,ptr) + ,@args))) + ;;; We'd like for the bytecode to be able to handle foreign calls, but it ;;; doesn't make sense for it to handle them directly. So, we provide a ;;; %%foreign-funcall function, and a definition of foreign-call-pointer @@ -481,6 +517,8 @@ %mem-set %foreign-funcall %foreign-funcall-pointer + %foreign-funcall-varargs + %foreign-funcall-pointer-varargs %load-foreign-library %close-foreign-library %foreign-symbol-pointer diff --git a/src/lisp/regression-tests/defcallback-native.lisp b/src/lisp/regression-tests/defcallback-native.lisp index 7911c6d0bc..3216713ce5 100644 --- a/src/lisp/regression-tests/defcallback-native.lisp +++ b/src/lisp/regression-tests/defcallback-native.lisp @@ -34,3 +34,29 @@ collect (clasp-ffi:%mem-ref array :int (* i intsize)))) (clasp-ffi:%foreign-free array))) ((1 2 3 4 5 6 7 8 9 10))) + +;;; fcntl(int fd, int cmd, ...) has a variadic third argument. Calling it through +;;; a non-variadic function type is undefined behaviour that happens to work on +;;; x86-64 SysV, where variadic arguments use the same registers as fixed ones, +;;; and loses the argument on Darwin arm64, where they are passed on the stack: +;;; the callee reads an unwritten slot and sees zero. shm_open's mode is the +;;; usual casualty. F_GETFD=1, F_SETFD=2 and FD_CLOEXEC=1 on both Linux and macOS. +(test-true foreign-funcall-varargs-passes-variadic-argument + (multiple-value-bind (r w) (core:pipe) + (declare (ignore w)) + (clasp-ffi:%foreign-funcall-varargs "fcntl" 2 :int r :int 2 :int 1 :int) + (eql 1 (clasp-ffi:%foreign-funcall "fcntl" :int r :int 1 :int)))) + +(test-true foreign-funcall-pointer-varargs-passes-variadic-argument + (multiple-value-bind (r w) (core:pipe) + (declare (ignore w)) + (let ((fcntl (core:dlsym :rtld-default "fcntl"))) + (clasp-ffi:%foreign-funcall-pointer-varargs fcntl 2 :int r :int 2 :int 1 :int) + (eql 1 (clasp-ffi:%foreign-funcall "fcntl" :int r :int 1 :int))))) + +;;; A call with no variadic arguments must be unaffected: it still builds a +;;; non-variadic function type and must succeed rather than return -1. +(test-true foreign-funcall-fixed-args-unaffected + (multiple-value-bind (r w) (core:pipe) + (declare (ignore w)) + (>= (clasp-ffi:%foreign-funcall "fcntl" :int r :int 1 :int) 0)))