add fix for long-long support in cffi for ecl

Nikolay V. Razbegaev [2010-11-17 11:00]
add fix for long-long support in cffi for ecl
Filename
ecl-long-long-fix.lisp
iolib.termios.asd
diff --git a/ecl-long-long-fix.lisp b/ecl-long-long-fix.lisp
new file mode 100644
index 0000000..d221517
--- /dev/null
+++ b/ecl-long-long-fix.lisp
@@ -0,0 +1,57 @@
+;;;; Fix long-long support for ecl in recent cffi version (from quicklisp)
+
+(in-package #:cffi-sys)
+
+(setf *features* (remove 'cffi-features:no-long-long *features*))
+(setf *features* (remove 'cffi-sys::no-long-long *features*))
+
+#+uint64-t
+(let ((tab (symbol-value '+translation-table+)))
+  (unless (ignore-errors (cffi-type->ecl-type :long-long))
+    (push '(:long-long :uint64-t "long long") tab)
+    (push '(:unsigned-long-long :uint64-t "unsigned long long") tab)
+    (defconstant +translation-table+ tab)))
+
+
+
+;;; si:make-foreign-data-from-array cat return pointer
+;;; to the vector data, but for a few types
+(defun %vector-address (vector)
+  "Return the address of VECTOR's data."
+  (si:make-foreign-data-from-array vector))
+
+;;; ECL, built with the Boehm GC never moves allocated data, so this
+;;; isn't nearly as hard to do. In fact, we support a bunch of vector
+;;; types that other backends don't, but such possibility avaliable
+;;; only at compile time, not at run time
+(define-compiler-macro %vector-address (vector)
+  "Return the address of VECTOR's data."
+  `(progn
+     (check-type ,vector
+ 		 (or (vector (unsigned-byte 8))
+ 		     (vector (signed-byte 8))
+ 		     #+uint16-t (vector (unsigned-byte 16))
+ 		     #+uint16-t (vector (signed-byte 16))
+ 		     #+uint32-t (vector (unsigned-byte 32))
+ 		     #+uint32-t (vector (signed-byte 32))
+ 		     #+uint64-t (vector (unsigned-byte 64))
+ 		     #+uint64-t (vector (signed-byte 64))
+ 		     (vector single-float)
+ 		     (vector double-float)
+ 		     (vector bit)
+ 		     (vector base-char)
+ 		     #+unicode (vector character)))
+     ;; ecl_array_data is a union, so we don't have to pick the specific
+     ;; fields out of it, so long as we know the array has the expected
+     ;; type.
+     (ffi:c-inline (,vector) (object) :unsigned-long
+ 		   "(unsigned long) #0->vector.self.b8"
+ 		   :side-effects nil
+ 		   :one-liner t)))
+
+
+(defmacro with-pointer-to-vector-data ((ptr-var vector) &body body)
+  "Bind PTR-VAR to a foreign pointer to the data in VECTOR."
+  `(let ((,ptr-var (make-pointer (%vector-address ,vector))))
+     ,@body))
+;;;; EOF
diff --git a/iolib.termios.asd b/iolib.termios.asd
index fc3443b..ec49218 100644
--- a/iolib.termios.asd
+++ b/iolib.termios.asd
@@ -1,21 +1,29 @@
-;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(in-package :common-lisp-user)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
+
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (asdf:oos 'asdf:load-op :cffi-grovel))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(asdf:defsystem :iolib.termios
+
+;;; Fix ecl long-long support
+#+(and ecl (or cffi-features:no-long-long cffi-sys::no-long-long))
+(defmethod perform :after ((o load-op) (c (eql (find-system :cffi))))
+  (let* ((s (find-system :iolib.termios))
+         (f (find-component s "ecl-long-long-fix")))
+    (oos 'load-op f)))
+
+(defsystem :iolib.termios
   :description "Termios (3p) api wrappers"
   :maintainer "Razbegaev N.V. <marsijanin@gmail.com>"
   :licence "MIT"
   :depends-on (:iolib.base :iolib.syscalls :iolib.streams :cffi :cffi-grovel)
   :components
-  ((:file "pkgdcl")
-   #+unix(cffi-grovel:grovel-file "ffi-termios-types-unix")
-   #+unix(cffi-grovel:grovel-file "ffi-termios-constants-unix")
-   #+unix(:file "ffi-termios-functions-unix")
+  #+unix
+  (#+ecl
+   (:file "ecl-long-long-fix")
+   (:file "pkgdcl")
+   (cffi-grovel:grovel-file "ffi-termios-types-unix")
+   (cffi-grovel:grovel-file "ffi-termios-constants-unix")
+   (:file "ffi-termios-functions-unix")
    (:file "conditions")
    (:file "wrappers")
    (:file "streams")))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; EOF
ViewGit