<commit_before>;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
;;; functions.lisp -- Calling foreign functions
;;;
;;; Copyright (C) 2009, 2010, 2011 <NAME>  <<EMAIL>>
;;;
;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation
;;; files (the "Software"), to deal in the Software without
;;; restriction, including without limitation the rights to use, copy,
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
;;; of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;;; DEALINGS IN THE SOFTWARE.
;;;

(in-package #:cffi-fsbv)

(defvar *cif-table* (make-hash-table :test 'equal)
  "A hash table of foreign functions and pointers to the foreign cif (Call InterFace) structure for that function.")

(define-condition foreign-function-not-prepared (error)
  ((foreign-function-name
    :initarg :foreign-function-name :reader foreign-function-name))
  (:report
   (lambda (condition stream)
     (format stream "Foreign function ~a did not prepare correctly"
	     (foreign-function-name condition))))
  (:documentation
   "Preparation of foreign function did not succeed, according to return from libffi library."))

(defun prepare-function
    (foreign-function-name return-type argument-types &optional (abi :default-abi))
  "Generate or retrieve the CIF needed to call the function through libffi."
  (or (gethash foreign-function-name *cif-table*)
      (let* ((number-of-arguments (length argument-types))
             (cif (cffi:foreign-alloc '(:struct ffi-cif)))
             (ffi-argtypes (cffi:foreign-alloc :pointer :count number-of-arguments)))
        (loop for type in argument-types
              for i from 0
              do
                 (setf (cffi:mem-aref ffi-argtypes :pointer i)
                       (libffi-type-pointer (parse-type type))))
        (unless
            (eql :OK
                 (prep-cif cif abi number-of-arguments
                           (libffi-type-pointer (parse-type return-type))
                           ffi-argtypes))
          (error
           'foreign-function-not-prepared
           :foreign-function-name foreign-function-name))
        (setf (gethash foreign-function-name *cif-table*) cif)
        cif)))

(defun unprepare-function (foreign-function-name)
  "Remove prepared definitions for the named foreign function.  Returns foreign-function-name if function had been prepared, NIL otherwise."
  (let ((ptr (gethash foreign-function-name *cif-table*)))
    (when ptr
      (cffi:foreign-free
       (cffi:foreign-slot-value ptr '(:struct ffi-cif) 'argument-types))
      (cffi:foreign-free ptr)
      (remhash foreign-function-name *cif-table*)
      foreign-function-name)))

(defun ffcall-body-libffi
    (function symbols return-type argument-types &optional pointerp (abi :default-abi))
  "A body of foreign-funcall calling the libffi function #'call (ffi_call)."
  (let ((number-of-arguments (length argument-types)))
    `(cffi:with-foreign-objects
         ((argvalues :pointer ,number-of-arguments)
          (result ',return-type))
       (loop :for arg :in (list ,@symbols)
             :for type :in ',argument-types
             :for count :from 0
             :do (setf (cffi:mem-aref argvalues :pointer count) arg))
       (call
        (prepare-function ,function ',return-type ',argument-types ',abi)
        ,(if pointerp
             function
             `(cffi:foreign-symbol-pointer ,function))
        result
        argvalues)
       ,(if (eql return-type :void)
            '(values)
            (if (typep (parse-type return-type) 'cffi::translatable-foreign-type)
                ;; just return the pointer so that expand-from-foreign
                ;; can apply translate-from-foreign
                'result
                ;; built-in types won't be translated by
                ;; expand-from-foreign, we have to do it here
                `(cffi:mem-aref result ',return-type))))))

(setf *foreign-structures-by-value* 'ffcall-body-libffi)

(pushnew :fsbv *features*)
<commit_msg>Call-by-value with :void return, do not allocate return object<commit_after>;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
;;; functions.lisp -- Calling foreign functions
;;;
;;; Copyright (C) 2009, 2010, 2011 <NAME>  <<EMAIL>>
;;;
;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation
;;; files (the "Software"), to deal in the Software without
;;; restriction, including without limitation the rights to use, copy,
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
;;; of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;;; DEALINGS IN THE SOFTWARE.
;;;

(in-package #:cffi-fsbv)

(defvar *cif-table* (make-hash-table :test 'equal)
  "A hash table of foreign functions and pointers to the foreign cif (Call InterFace) structure for that function.")

(define-condition foreign-function-not-prepared (error)
  ((foreign-function-name
    :initarg :foreign-function-name :reader foreign-function-name))
  (:report
   (lambda (condition stream)
     (format stream "Foreign function ~a did not prepare correctly"
	     (foreign-function-name condition))))
  (:documentation
   "Preparation of foreign function did not succeed, according to return from libffi library."))

(defun prepare-function
    (foreign-function-name return-type argument-types &optional (abi :default-abi))
  "Generate or retrieve the CIF needed to call the function through libffi."
  (or (gethash foreign-function-name *cif-table*)
      (let* ((number-of-arguments (length argument-types))
             (cif (cffi:foreign-alloc '(:struct ffi-cif)))
             (ffi-argtypes (cffi:foreign-alloc :pointer :count number-of-arguments)))
        (loop for type in argument-types
              for i from 0
              do
                 (setf (cffi:mem-aref ffi-argtypes :pointer i)
                       (libffi-type-pointer (parse-type type))))
        (unless
            (eql :OK
                 (prep-cif cif abi number-of-arguments
                           (libffi-type-pointer (parse-type return-type))
                           ffi-argtypes))
          (error
           'foreign-function-not-prepared
           :foreign-function-name foreign-function-name))
        (setf (gethash foreign-function-name *cif-table*) cif)
        cif)))

(defun unprepare-function (foreign-function-name)
  "Remove prepared definitions for the named foreign function.  Returns foreign-function-name if function had been prepared, NIL otherwise."
  (let ((ptr (gethash foreign-function-name *cif-table*)))
    (when ptr
      (cffi:foreign-free
       (cffi:foreign-slot-value ptr '(:struct ffi-cif) 'argument-types))
      (cffi:foreign-free ptr)
      (remhash foreign-function-name *cif-table*)
      foreign-function-name)))

(defun ffcall-body-libffi
    (function symbols return-type argument-types &optional pointerp (abi :default-abi))
  "A body of foreign-funcall calling the libffi function #'call (ffi_call)."
  (let ((number-of-arguments (length argument-types)))
    `(cffi:with-foreign-objects
         ((argvalues :pointer ,number-of-arguments)
          ,@(unless (eql return-type :void)
              `((result ',return-type))))
       (loop :for arg :in (list ,@symbols)
             :for type :in ',argument-types
             :for count :from 0
             :do (setf (cffi:mem-aref argvalues :pointer count) arg))
       (call
        (prepare-function ,function ',return-type ',argument-types ',abi)
        ,(if pointerp
             function
             `(cffi:foreign-symbol-pointer ,function))
        ,(if (eql return-type :void) '(cffi:null-pointer) 'result)
        argvalues)
       ,(if (eql return-type :void)
            '(values)
            (if (typep (parse-type return-type) 'cffi::translatable-foreign-type)
                ;; just return the pointer so that expand-from-foreign
                ;; can apply translate-from-foreign
                'result
                ;; built-in types won't be translated by
                ;; expand-from-foreign, we have to do it here
                `(cffi:mem-aref result ',return-type))))))

(setf *foreign-structures-by-value* 'ffcall-body-libffi)

(pushnew :fsbv *features*)

{'fraction_non_alphanumeric': 0.11503051618909693, 'fraction_numerical': 0.002896451846488052, 'mean_word_length': 2.8594810379241515, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 9, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4359017', 'n_tokens_mistral': 2862, 'n_tokens_neox': 2687, 'n_words': 941}