From 8629618e9bb0dfc750d01fc4990404c78ab41705 Mon Sep 17 00:00:00 2001 From: Stelian Ionescu Date: Tue, 8 Nov 2022 18:03:18 -0500 Subject: [PATCH] Refactor core package definitions Coalesced all definitions of :cffi-sys into one. Moved all packages (cffi-sys, cffi, cffi-callbacks) into package.lisp, which now becomes the first file in the system. Moved the compiler-macro utils to sys-utils.lisp, part of cffi-sys, then export CONSTANT-FORM-P and CONSTANT-FORM-VALUE. --- cffi.asd | 5 +- src/cffi-abcl.lisp | 38 ---------------- src/cffi-allegro.lisp | 38 ---------------- src/cffi-clasp.lisp | 32 ------------- src/cffi-clisp.lisp | 32 ------------- src/cffi-cmucl.lisp | 39 ---------------- src/cffi-corman.lisp | 32 ------------- src/cffi-ecl.lisp | 42 ----------------- src/cffi-gcl.lisp | 24 ---------- src/cffi-lispworks.lisp | 39 ---------------- src/cffi-mcl.lisp | 39 ---------------- src/cffi-mkcl.lisp | 38 ---------------- src/cffi-openmcl.lisp | 39 ---------------- src/cffi-sbcl.lisp | 36 --------------- src/cffi-scl.lisp | 33 -------------- src/features.lisp | 33 -------------- src/package.lisp | 118 +++++++++++++++++++++++++++++++++++++++++++++++- src/sys-utils.lisp | 53 ++++++++++++++++++++++ src/utils.lisp | 25 ---------- 19 files changed, 173 insertions(+), 562 deletions(-) create mode 100644 src/sys-utils.lisp diff --git a/cffi.asd b/cffi.asd index 93df18e..a9794db 100644 --- a/cffi.asd +++ b/cffi.asd @@ -43,7 +43,9 @@ ((:module "src" :serial t :components - ((:file "cffi-openmcl" :if-feature :openmcl) + ((:file "package") + (:file "sys-utils") + (:file "cffi-openmcl" :if-feature :openmcl) (:file "cffi-mcl" :if-feature :mcl) (:file "cffi-sbcl" :if-feature :sbcl) (:file "cffi-cmucl" :if-feature :cmucl) @@ -56,7 +58,6 @@ (:file "cffi-abcl" :if-feature :abcl) (:file "cffi-mkcl" :if-feature :mkcl) (:file "cffi-clasp" :if-feature :clasp) - (:file "package") (:file "utils") (:file "libraries") (:file "early-types") diff --git a/src/cffi-abcl.lisp b/src/cffi-abcl.lisp index 6d9362c..386ff10 100644 --- a/src/cffi-abcl.lisp +++ b/src/cffi-abcl.lisp @@ -32,49 +32,11 @@ ;;; JNA may be automatically loaded into the current JVM process from ;;; abcl-1.1.0-dev via the contrib mechanism. -(eval-when (:compile-toplevel :load-toplevel :execute) - (require :abcl-contrib) - (require :jna) - (require :jss)) - ;;; This is a preliminary version that will have to be cleaned up, ;;; optimized, etc. Nevertheless, it passes all of the relevant CFFI ;;; tests except MAKE-POINTER.HIGH. Shareable Vectors are not ;;; implemented yet. -;;;# Administrivia - -(defpackage #:cffi-sys - (:use #:cl #:java) - (:import-from #:alexandria #:hash-table-values #:length= #:format-symbol) - (:export - #:canonicalize-symbol-name-case - #:foreign-pointer - #:pointerp - #:pointer-eq - #:null-pointer - #:null-pointer-p - #:inc-pointer - #:make-pointer - #:pointer-address - #:%foreign-alloc - #:foreign-free - #:with-foreign-pointer - #:%foreign-funcall - #:%foreign-funcall-pointer - #:%foreign-type-alignment - #:%foreign-type-size - #:%load-foreign-library - #:%close-foreign-library - #:native-namestring - #:%mem-ref - #:%mem-set - #:%foreign-symbol-pointer - #:%defcallback - #:%callback - #:with-pointer-to-vector-data - #:make-shareable-byte-vector)) - (in-package #:cffi-sys) ;;;# Loading and Closing Foreign Libraries diff --git a/src/cffi-allegro.lisp b/src/cffi-allegro.lisp index d3d79fe..7b0ff66 100644 --- a/src/cffi-allegro.lisp +++ b/src/cffi-allegro.lisp @@ -25,40 +25,6 @@ ;;; DEALINGS IN THE SOFTWARE. ;;; -;;;# Administrivia - -(defpackage #:cffi-sys - (:use #:common-lisp) - (:import-from #:alexandria #:if-let #:with-unique-names #:once-only) - (:export - #:canonicalize-symbol-name-case - #:foreign-pointer - #:pointerp - #:pointer-eq - #:null-pointer - #:null-pointer-p - #:inc-pointer - #:make-pointer - #:pointer-address - #:%foreign-alloc - #:foreign-free - #:with-foreign-pointer - #:%foreign-funcall - #:%foreign-funcall-pointer - #:%foreign-type-alignment - #:%foreign-type-size - #:%load-foreign-library - #:%close-foreign-library - #:native-namestring - #:%mem-ref - #:%mem-set - #:make-shareable-byte-vector - #:with-pointer-to-vector-data - #:%foreign-symbol-pointer - #:defcfun-helper-forms - #:%defcallback - #:%callback)) - (in-package #:cffi-sys) ;;;# Mis-features @@ -371,10 +337,6 @@ WITH-POINTER-TO-VECTOR-DATA." (eval-when (:load-toplevel :execute) (pushnew 'restore-callbacks excl:*restart-actions*)) -;;; Create a package to contain the symbols for callback functions. -(defpackage #:cffi-callbacks - (:use)) - (defun intern-callback (name) (intern (format nil "~A::~A" (if-let (package (symbol-package name)) diff --git a/src/cffi-clasp.lisp b/src/cffi-clasp.lisp index 5591bf1..27b3e18 100644 --- a/src/cffi-clasp.lisp +++ b/src/cffi-clasp.lisp @@ -25,38 +25,6 @@ ;;; DEALINGS IN THE SOFTWARE. ;;; -;;;# Administrivia - -(defpackage #:cffi-sys - (:use #:common-lisp #:alexandria) - (:export - #:canonicalize-symbol-name-case - #:foreign-pointer - #:pointerp - #:pointer-eq - #:%foreign-alloc - #:foreign-free - #:with-foreign-pointer - #:null-pointer - #:null-pointer-p - #:inc-pointer - #:make-pointer - #:pointer-address - #:%mem-ref - #:%mem-set - #:%foreign-funcall - #:%foreign-funcall-pointer - #:%foreign-type-alignment - #:%foreign-type-size - #:%load-foreign-library - #:%close-foreign-library - #:native-namestring - #:make-shareable-byte-vector - #:with-pointer-to-vector-data - #:%defcallback - #:%callback - #:%foreign-symbol-pointer)) - (in-package #:cffi-sys) ;;;# Mis-features diff --git a/src/cffi-clisp.lisp b/src/cffi-clisp.lisp index 9b92799..92c3856 100644 --- a/src/cffi-clisp.lisp +++ b/src/cffi-clisp.lisp @@ -26,38 +26,6 @@ ;;; DEALINGS IN THE SOFTWARE. ;;; -;;;# Administrivia - -(defpackage #:cffi-sys - (:use #:common-lisp #:alexandria) - (:export - #:canonicalize-symbol-name-case - #:foreign-pointer - #:pointerp - #:pointer-eq - #:null-pointer - #:null-pointer-p - #:inc-pointer - #:make-pointer - #:pointer-address - #:%foreign-alloc - #:foreign-free - #:with-foreign-pointer - #:%foreign-funcall - #:%foreign-funcall-pointer - #:%foreign-type-alignment - #:%foreign-type-size - #:%load-foreign-library - #:%close-foreign-library - #:native-namestring - #:%mem-ref - #:%mem-set - #:make-shareable-byte-vector - #:with-pointer-to-vector-data - #:%foreign-symbol-pointer - #:%defcallback - #:%callback)) - (in-package #:cffi-sys) (eval-when (:compile-toplevel :load-toplevel :execute) diff --git a/src/cffi-cmucl.lisp b/src/cffi-cmucl.lisp index 210bb2a..a5fd8b5 100644 --- a/src/cffi-cmucl.lisp +++ b/src/cffi-cmucl.lisp @@ -25,39 +25,6 @@ ;;; DEALINGS IN THE SOFTWARE. ;;; -;;;# Administrivia - -(defpackage #:cffi-sys - (:use #:common-lisp #:alien #:c-call) - (:import-from #:alexandria #:once-only #:with-unique-names #:if-let) - (:export - #:canonicalize-symbol-name-case - #:foreign-pointer - #:pointerp - #:pointer-eq - #:null-pointer - #:null-pointer-p - #:inc-pointer - #:make-pointer - #:pointer-address - #:%foreign-alloc - #:foreign-free - #:with-foreign-pointer - #:%foreign-funcall - #:%foreign-funcall-pointer - #:%foreign-type-alignment - #:%foreign-type-size - #:%load-foreign-library - #:%close-foreign-library - #:native-namestring - #:%mem-ref - #:%mem-set - #:make-shareable-byte-vector - #:with-pointer-to-vector-data - #:%foreign-symbol-pointer - #:%defcallback - #:%callback)) - (in-package #:cffi-sys) ;;;# Misfeatures @@ -287,12 +254,6 @@ WITH-POINTER-TO-VECTOR-DATA." (defvar *callbacks* (make-hash-table)) -;;; Create a package to contain the symbols for callback functions. We -;;; want to redefine callbacks with the same symbol so the internal data -;;; structures are reused. -(defpackage #:cffi-callbacks - (:use)) - ;;; Intern a symbol in the CFFI-CALLBACKS package used to name the internal ;;; callback for NAME. (eval-when (:compile-toplevel :load-toplevel :execute) diff --git a/src/cffi-corman.lisp b/src/cffi-corman.lisp index 14e7d61..8a2dfa4 100644 --- a/src/cffi-corman.lisp +++ b/src/cffi-corman.lisp @@ -29,38 +29,6 @@ ;;; is too funky with ASDF, crashes easily, makes it very painful to ;;; do any testing. -- luis -;;;# Administrivia - -(defpackage #:cffi-sys - (:use #:common-lisp #:c-types) - (:import-from #:alexandria #:with-unique-names) - (:export - #:canonicalize-symbol-name-case - #:foreign-pointer - #:pointerp - #:pointer-eq - #:null-pointer - #:null-pointer-p - #:inc-pointer - #:make-pointer - #:pointer-address - #:%foreign-alloc - #:foreign-free - #:with-foreign-pointer - #:%foreign-funcall - #:%foreign-type-alignment - #:%foreign-type-size - #:%load-foreign-library - #:native-namestring - #:%mem-ref - #:%mem-set - ;#:make-shareable-byte-vector - ;#:with-pointer-to-vector-data - #:foreign-symbol-pointer - #:defcfun-helper-forms - #:%defcallback - #:%callback)) - (in-package #:cffi-sys) ;;;# Misfeatures diff --git a/src/cffi-ecl.lisp b/src/cffi-ecl.lisp index 0b595ef..5817a70 100644 --- a/src/cffi-ecl.lisp +++ b/src/cffi-ecl.lisp @@ -25,42 +25,6 @@ ;;; DEALINGS IN THE SOFTWARE. ;;; -;;;# Administrivia - -(defpackage #:cffi-sys - (:use #:common-lisp #:alexandria) - (:import-from #:si #:null-pointer-p) - (:export - #:*cffi-ecl-method* - #:canonicalize-symbol-name-case - #:foreign-pointer - #:pointerp - #:pointer-eq - #:%foreign-alloc - #:foreign-free - #:with-foreign-pointer - #:null-pointer - #:null-pointer-p - #:inc-pointer - #:make-pointer - #:pointer-address - #:%mem-ref - #:%mem-set - #:%foreign-funcall - #:%foreign-funcall-pointer - #:%foreign-funcall-varargs - #:%foreign-funcall-pointer-varargs - #:%foreign-type-alignment - #:%foreign-type-size - #:%load-foreign-library - #:%close-foreign-library - #:native-namestring - #:make-shareable-byte-vector - #:with-pointer-to-vector-data - #:%defcallback - #:%callback - #:%foreign-symbol-pointer)) - (in-package #:cffi-sys) ;;; @@ -403,12 +367,6 @@ WITH-POINTER-TO-VECTOR-DATA." ;;;# Callbacks -;;; Create a package to contain the symbols for callback functions. -;;; We want to redefine callbacks with the same symbol so the internal -;;; data structures are reused. -(defpackage #:cffi-callbacks - (:use)) - (defvar *callbacks* (make-hash-table)) ;;; Intern a symbol in the CFFI-CALLBACKS package used to name the diff --git a/src/cffi-gcl.lisp b/src/cffi-gcl.lisp index 4a6bd04..d78ff19 100644 --- a/src/cffi-gcl.lisp +++ b/src/cffi-gcl.lisp @@ -39,30 +39,6 @@ ;;; *** this port is broken *** ;;; gcl doesn't compile the rest of CFFI anyway.. -;;;# Administrivia - -(defpackage #:cffi-sys - (:use #:common-lisp #:alexandria) - (:export - #:canonicalize-symbol-name-case - #:pointerp - #:%foreign-alloc - #:foreign-free - #:with-foreign-ptr - #:null-ptr - #:null-ptr-p - #:inc-ptr - #:%mem-ref - #:%mem-set - #:%foreign-funcall - #:%foreign-type-alignment - #:%foreign-type-size - #:%load-foreign-library - ;#:make-shareable-byte-vector - ;#:with-pointer-to-vector-data - #:foreign-var-ptr - #:make-callback)) - (in-package #:cffi-sys) ;;;# Mis-*features* diff --git a/src/cffi-lispworks.lisp b/src/cffi-lispworks.lisp index d0932b8..75009a1 100644 --- a/src/cffi-lispworks.lisp +++ b/src/cffi-lispworks.lisp @@ -25,39 +25,6 @@ ;;; DEALINGS IN THE SOFTWARE. ;;; -;;;# Administrivia - -(defpackage #:cffi-sys - (:use #:cl #:alexandria) - (:export - #:canonicalize-symbol-name-case - #:foreign-pointer - #:pointerp - #:pointer-eq - #:null-pointer - #:null-pointer-p - #:inc-pointer - #:make-pointer - #:pointer-address - #:%foreign-alloc - #:foreign-free - #:with-foreign-pointer - #:%foreign-funcall - #:%foreign-funcall-pointer - #:%foreign-type-alignment - #:%foreign-type-size - #:%load-foreign-library - #:%close-foreign-library - #:native-namestring - #:%mem-ref - #:%mem-set - #:make-shareable-byte-vector - #:with-pointer-to-vector-data - #:%foreign-symbol-pointer - #:defcfun-helper-forms - #:%defcallback - #:%callback)) - (in-package #:cffi-sys) ;;;# Misfeatures @@ -353,12 +320,6 @@ and caches it if necessary. Finally calls it." (defvar *callbacks* (make-hash-table)) -;;; Create a package to contain the symbols for callback functions. We -;;; want to redefine callbacks with the same symbol so the internal data -;;; structures are reused. -(defpackage #:cffi-callbacks - (:use)) - ;;; Intern a symbol in the CFFI-CALLBACKS package used to name the internal ;;; callback for NAME. (eval-when (:compile-toplevel :load-toplevel :execute) diff --git a/src/cffi-mcl.lisp b/src/cffi-mcl.lisp index cf61eb3..1dcf137 100644 --- a/src/cffi-mcl.lisp +++ b/src/cffi-mcl.lisp @@ -37,39 +37,6 @@ ;;; once a framework exists, load it as, eg. ;;; (ccl::add-framework-bundle "fftw.framework" :pathname "ccl:frameworks;" ) -;;;# Administrivia - -(defpackage #:cffi-sys - (:use #:common-lisp #:ccl) - (:import-from #:alexandria #:once-only #:if-let) - (:export - #:canonicalize-symbol-name-case - #:foreign-pointer - #:pointerp ; ccl:pointerp - #:pointer-eq - #:%foreign-alloc - #:foreign-free - #:with-foreign-pointer - #:null-pointer - #:null-pointer-p - #:inc-pointer - #:make-pointer - #:pointer-address - #:%mem-ref - #:%mem-set - #:%foreign-funcall - #:%foreign-funcall-pointer - #:%foreign-type-alignment - #:%foreign-type-size - #:%load-foreign-library - #:%close-foreign-library - #:native-namestring - #:make-shareable-byte-vector - #:with-pointer-to-vector-data - #:%foreign-symbol-pointer - #:%defcallback - #:%callback)) - (in-package #:cffi-sys) ;;;# Misfeatures @@ -321,12 +288,6 @@ WITH-POINTER-TO-VECTOR-DATA." ;;; is loaded (see CCL::RESTORE-PASCAL-FUNCTIONS). (defvar *callbacks* (make-hash-table)) -;;; Create a package to contain the symbols for callback functions. We -;;; want to redefine callbacks with the same symbol so the internal data -;;; structures are reused. -(defpackage #:cffi-callbacks - (:use)) - ;;; Intern a symbol in the CFFI-CALLBACKS package used to name the internal ;;; callback for NAME. (defun intern-callback (name) diff --git a/src/cffi-mkcl.lisp b/src/cffi-mkcl.lisp index 0e46503..2480a62 100644 --- a/src/cffi-mkcl.lisp +++ b/src/cffi-mkcl.lisp @@ -26,38 +26,6 @@ ;;; DEALINGS IN THE SOFTWARE. ;;; -;;;# Administrivia - -(defpackage #:cffi-sys - (:use #:common-lisp #:alexandria) - (:export - #:canonicalize-symbol-name-case - #:foreign-pointer - #:pointerp - #:pointer-eq - #:null-pointer - #:null-pointer-p - #:inc-pointer - #:make-pointer - #:pointer-address - #:%foreign-alloc - #:foreign-free - #:with-foreign-pointer - #:%foreign-funcall - #:%foreign-funcall-pointer - #:%foreign-type-alignment - #:%foreign-type-size - #:%load-foreign-library - #:%close-foreign-library - #:native-namestring - #:%mem-ref - #:%mem-set - #:make-shareable-byte-vector - #:with-pointer-to-vector-data - #:%foreign-symbol-pointer - #:%defcallback - #:%callback)) - (in-package #:cffi-sys) ;;;# Mis-features @@ -294,12 +262,6 @@ WITH-POINTER-TO-VECTOR-DATA." ;;;# Callbacks -;;; Create a package to contain the symbols for callback functions. -;;; We want to redefine callbacks with the same symbol so the internal -;;; data structures are reused. -(defpackage #:cffi-callbacks - (:use)) - (defvar *callbacks* (make-hash-table)) ;;; Intern a symbol in the CFFI-CALLBACKS package used to name the diff --git a/src/cffi-openmcl.lisp b/src/cffi-openmcl.lisp index 5a53ad0..8516807 100644 --- a/src/cffi-openmcl.lisp +++ b/src/cffi-openmcl.lisp @@ -25,39 +25,6 @@ ;;; DEALINGS IN THE SOFTWARE. ;;; -;;;# Administrivia - -(defpackage #:cffi-sys - (:use #:common-lisp #:ccl) - (:import-from #:alexandria #:once-only #:if-let) - (:export - #:canonicalize-symbol-name-case - #:foreign-pointer - #:pointerp ; ccl:pointerp - #:pointer-eq - #:%foreign-alloc - #:foreign-free - #:with-foreign-pointer - #:null-pointer - #:null-pointer-p - #:inc-pointer - #:make-pointer - #:pointer-address - #:%mem-ref - #:%mem-set - #:%foreign-funcall - #:%foreign-funcall-pointer - #:%foreign-type-alignment - #:%foreign-type-size - #:%load-foreign-library - #:%close-foreign-library - #:native-namestring - #:make-shareable-byte-vector - #:with-pointer-to-vector-data - #:%foreign-symbol-pointer - #:%defcallback - #:%callback)) - (in-package #:cffi-sys) ;;;# Misfeatures @@ -256,12 +223,6 @@ WITH-POINTER-TO-VECTOR-DATA." ;;; is loaded (see CCL::RESTORE-PASCAL-FUNCTIONS). (defvar *callbacks* (make-hash-table)) -;;; Create a package to contain the symbols for callback functions. We -;;; want to redefine callbacks with the same symbol so the internal data -;;; structures are reused. -(defpackage #:cffi-callbacks - (:use)) - ;;; Intern a symbol in the CFFI-CALLBACKS package used to name the internal ;;; callback for NAME. (defun intern-callback (name) diff --git a/src/cffi-sbcl.lisp b/src/cffi-sbcl.lisp index ef939ad..af097cf 100644 --- a/src/cffi-sbcl.lisp +++ b/src/cffi-sbcl.lisp @@ -25,42 +25,6 @@ ;;; DEALINGS IN THE SOFTWARE. ;;; -;;;# Administrivia - -(defpackage #:cffi-sys - (:use #:common-lisp #:sb-alien) - (:import-from #:alexandria - #:once-only #:with-unique-names #:when-let #:removef) - (:export - #:canonicalize-symbol-name-case - #:foreign-pointer - #:pointerp - #:pointer-eq - #:null-pointer - #:null-pointer-p - #:inc-pointer - #:make-pointer - #:pointer-address - #:%foreign-alloc - #:foreign-free - #:with-foreign-pointer - #:%foreign-funcall - #:%foreign-funcall-pointer - #:%foreign-funcall-varargs - #:%foreign-funcall-pointer-varargs - #:%foreign-type-alignment - #:%foreign-type-size - #:%load-foreign-library - #:%close-foreign-library - #:native-namestring - #:%mem-ref - #:%mem-set - #:make-shareable-byte-vector - #:with-pointer-to-vector-data - #:%foreign-symbol-pointer - #:%defcallback - #:%callback)) - (in-package #:cffi-sys) ;;;# Misfeatures diff --git a/src/cffi-scl.lisp b/src/cffi-scl.lisp index fe2fdb1..524e93d 100644 --- a/src/cffi-scl.lisp +++ b/src/cffi-scl.lisp @@ -26,39 +26,6 @@ ;;; DEALINGS IN THE SOFTWARE. ;;; -;;;# Administrivia - -(defpackage #:cffi-sys - (:use #:common-lisp #:alien #:c-call) - (:import-from #:alexandria #:once-only #:with-unique-names) - (:export - #:canonicalize-symbol-name-case - #:foreign-pointer - #:pointerp - #:pointer-eq - #:null-pointer - #:null-pointer-p - #:inc-pointer - #:make-pointer - #:pointer-address - #:%foreign-alloc - #:foreign-free - #:with-foreign-pointer - #:%foreign-funcall - #:%foreign-funcall-pointer - #:%foreign-type-alignment - #:%foreign-type-size - #:%load-foreign-library - #:%close-foreign-library - #:native-namestring - #:%mem-ref - #:%mem-set - #:make-shareable-byte-vector - #:with-pointer-to-vector-data - #:%foreign-symbol-pointer - #:%defcallback - #:%callback)) - (in-package #:cffi-sys) ;;;# Mis-features diff --git a/src/features.lisp b/src/features.lisp index 0cdc6ca..fc39efc 100644 --- a/src/features.lisp +++ b/src/features.lisp @@ -38,39 +38,6 @@ ;;; deprecated and this code will stay here for a while for backwards ;;; compatibility purposes, to be removed in a future release. -(defpackage #:cffi-features - (:use #:cl) - (:export - #:cffi-feature-p - - ;; Features related to the CFFI-SYS backend. Why no-*? This - ;; reflects the hope that these symbols will go away completely - ;; meaning that at some point all lisps will support long-longs, - ;; the foreign-funcall primitive, etc... - #:no-long-long - #:no-foreign-funcall - #:no-stdcall - #:flat-namespace - - ;; Only SCL supports long-double... - ;;#:no-long-double - - ;; Features related to the operating system. - ;; More should be added. - #:darwin - #:unix - #:windows - - ;; Features related to the processor. - ;; More should be added. - #:ppc32 - #:x86 - #:x86-64 - #:sparc - #:sparc64 - #:hppa - #:hppa64)) - (in-package #:cffi-features) (defun cffi-feature-p (feature-expression) diff --git a/src/package.lisp b/src/package.lisp index 2d6fd24..ee71a04 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -3,6 +3,8 @@ ;;; package.lisp --- Package definition for CFFI. ;;; ;;; Copyright (C) 2005-2006, James Bielman +;;; Copyright (C) 2009, Luis Oliveira +;;; Copyright (C) 2012, Mark Evenson ;;; ;;; Permission is hereby granted, free of charge, to any person ;;; obtaining a copy of this software and associated documentation @@ -25,7 +27,121 @@ ;;; DEALINGS IN THE SOFTWARE. ;;; -(in-package #:cl-user) +#+abcl +(eval-when (:compile-toplevel :load-toplevel :execute) + (require :abcl-contrib) + (require :jna) + (require :jss)) + +;;;# Administrivia + +(defpackage #:cffi-sys + (:use #:common-lisp #:alexandria + #+abcl #:java + #+(or ccl mcl) #:ccl + #+cmu #:alien #+cmu #:c-call + #+corman #:c-types + #+sbcl #:sb-alien) + #+ecl + (:import-from #:si #:null-pointer-p) + (:shadow #:copy-file ; Conflicts with ccl:copy-file + ) + (:export + ;; Platform-specific functionality + #+ecl #:*cffi-ecl-method* + + ;; C ABI utils + #:canonicalize-symbol-name-case + #:defcfun-helper-forms + + ;; Pointers + #:foreign-pointer + #:pointerp + #:pointer-eq + #:null-pointer + #:null-pointer-p + #:inc-pointer + #:make-pointer + #:pointer-address + + ;; Memory operators + #:%mem-ref + #:%mem-set + + ;; Foreign symbols + #:%foreign-symbol-pointer + + ;; Memory management + #:%foreign-alloc + #:foreign-free + #:with-foreign-pointer + + ;; Foreign functions + #:%foreign-funcall + #:%foreign-funcall-pointer + #:%foreign-funcall-varargs + #:%foreign-funcall-pointer-varargs + #:%foreign-type-alignment + + ;; Foreign types + #:%foreign-type-size + + ;; Foreign libraries + #:%load-foreign-library + #:%close-foreign-library + #:native-namestring + + ;; Callbacks + #:%defcallback + #:%callback + + ;; Shareable vectors + #:make-shareable-byte-vector + #:with-pointer-to-vector-data + + ;; Compiler macro utils + #:constant-form-p + #:constant-form-value)) + +;;; Create a package to contain the symbols for callback functions. +;;; We want to redefine callbacks with the same symbol so the internal +;;; data structures are reused. +#+(or allegro ccl cmu ecl lispworks mkcl) +(defpackage #:cffi-callbacks + (:use)) + +(defpackage #:cffi-features + (:use #:cl) + (:export + #:cffi-feature-p + + ;; Features related to the CFFI-SYS backend. Why no-*? This + ;; reflects the hope that these symbols will go away completely + ;; meaning that at some point all lisps will support long-longs, + ;; the foreign-funcall primitive, etc... + #:no-long-long + #:no-foreign-funcall + #:no-stdcall + #:flat-namespace + + ;; Only SCL supports long-double... + ;;#:no-long-double + + ;; Features related to the operating system. + ;; More should be added. + #:darwin + #:unix + #:windows + + ;; Features related to the processor. + ;; More should be added. + #:ppc32 + #:x86 + #:x86-64 + #:sparc + #:sparc64 + #:hppa + #:hppa64)) (defpackage #:cffi (:use #:common-lisp #:cffi-sys #:babel-encodings) diff --git a/src/sys-utils.lisp b/src/sys-utils.lisp new file mode 100644 index 0000000..c77053d --- /dev/null +++ b/src/sys-utils.lisp @@ -0,0 +1,53 @@ +;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- +;;; +;;; sys-utils.lisp --- Various utilities. +;;; +;;; Copyright (C) 2022, Stelian Ionescu +;;; +;;; 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-sys) + +(defun quoted-form-p (form) + (and (proper-list-p form) + (= 2 (length form)) + (eql 'quote (car form)))) + +(defun constant-form-p (form &optional env) + (let ((form (if (symbolp form) + (macroexpand form env) + form))) + (or (quoted-form-p form) + (constantp form env)))) + +(defun constant-form-value (form &optional env) + (declare (ignorable env)) + (cond + ((quoted-form-p form) + (second form)) + (t + #+clozure + (ccl::eval-constant form) + #+sbcl + (sb-int:constant-form-value form env) + #-(or clozure sbcl) + (eval form)))) diff --git a/src/utils.lisp b/src/utils.lisp index b42efd6..7afaccd 100644 --- a/src/utils.lisp +++ b/src/utils.lisp @@ -82,28 +82,3 @@ set twos-complement bit." (the fixnum (1+ (the fixnum stop))) stop)) while stop))) - -(defun quoted-form-p (form) - (and (listp form) - (= 2 (length form)) - (eql 'quote (car form)))) - -(defun constant-form-p (form &optional env) - (let ((form (if (symbolp form) - (macroexpand form env) - form))) - (or (quoted-form-p form) - (constantp form env)))) - -(defun constant-form-value (form &optional env) - (declare (ignorable env)) - (cond - ((quoted-form-p form) - (second form)) - (t - #+clozure - (ccl::eval-constant form) - #+sbcl - (sb-int:constant-form-value form env) - #-(or clozure sbcl) - (eval form)))) -- 2.11.4.GIT