[cffi-devel] testing equality on system objects
Sean Champ
gimmal at gmail.com
Mon Aug 14 18:00:22 UTC 2006
Hello,
I was migrating some code from one of my own codebases into an archive for
the Tioga project, when I noticed the following function. It's used in
facilitating a function called EQLP, in comparison onto ALIEN objects. I
would like to submit this function, now, in case it would be of use in
CFFI; if it would be, I could be glad to remove the original form of it
from my own code.
This is an equality-predicate function, operating in comparison onto system
objects, viz ALIEN-VALUE objects.
#+(or CMU SBCL)
(shadowing-import
#+CMU
'(ext:fixnump ext:bignump)
#+SBCL
'(sb-int:fixnump sb-int:bignump))
#+CMU (use-package '#:SB-ALIEN)
#+SBCL (use-package '#:SB-ALIEN)
;; (hopefully that will cover all of the symbol-availability.)
;; (I have excerpted this from another package.)
(defun system-objects-eqlp (obj1 obj2 external-type)
(declare (type (or alien-value float integer) obj1 obj2)
(type alien-type external-type))
(typecase external-type
;; handle, first, those types for which OBJ1 and OBJ2 both must
;; have regular CL representations
(alien-integer-type
;; NB: ALIEN-ENUM-TYPE is handled here
(when (and (integerp obj1) (integerp obj2))
(cond
((and (fixnump obj1) (fixnump obj2))
(eql (the fixnum obj1)
(the fixnum obj2)))
((and (bignump obj1) (bignump obj2))
(eql (the bignum obj1)
(the bignum obj2))))))
(alien-float-type
(when (and (floatp obj1) (floatp obj2)
(eql (the float obj1)
(the float obj2)))
(values t)))
(t
(let ((o1-foreign-type (alien-value-type obj1))
(o2-foreign-type (alien-value-type obj2)))
(when (and (alien-type-= o1-foreign-type external-type)
(alien-type-= o2-foreign-type external-type))
(typecase external-type
(alien-fun-type
;; OBJ1 and OBJ2 are already determined as having
;; ALIEN-VALUE-TYPEs that are ALIEN-TYPE-= .
;;
;; Presumably, this is the only check remaining, then
(sap= (alien-sap obj1) (alien-sap obj2)))
(alien-record-type
(dolist (type-field (alien-record-type-fields external-type)
(values t))
;; referenced on #'SB-ALIEN:SLOT
(let ((field-offset (alien-record-field-offset type-field))
(field-type (alien-record-field-type type-field)))
(unless (system-objects-eqlp
;; referenced on DEREF and DEREF-GUTS
(extract-alien-value (alien-value-sap obj1)
field-offset
field-type)
(extract-alien-value (alien-value-sap obj2)
field-offset
field-type)
field-type)
(return (values nil))))))
(alien-pointer-type
(let ((dest-type (alien-pointer-type-to external-type)))
;; NB: This is made with the assumption that the offset 0 will be
;; applicable in all times in which this method will be called
;; -- namely, for all 'alien pointers' not representing 'alien
;; arrays'
;;
(cond
(dest-type
(system-objects-eqlp
;; referenced on #'DEREF & #'DEREF-GUTS
;;
;; Why this is enough, in lieu of DEREF :
;; 1) the EXTERNAL-TYPE is certainly an ALIEN-POINTER-TYPE
;; 2) there are no INDICES that must be provided, as if for
;; an equivalent DEREF call
;;
(extract-alien-value (alien-value-sap obj1) 0 dest-type)
(extract-alien-value (alien-value-sap obj2) 0 dest-type)
dest-type))
;; Conslusion: OBJ1 and OBJ2 are both 'null pointers'
(t t))))
(alien-array-type
(let* ((dimensions (copy-list (alien-array-type-dimensions
external-type)))
(etype (alien-array-type-element-type external-type))
(dim-ptr (1- (length dimensions))))
(loop
(when (zerop dim-ptr) (return t))
(let ((obj1-v (apply #'deref obj1 dimensions))
(obj2-v (apply #'deref obj2 dimensions)))
(unless (or (and (null obj1-v) (null obj2-v))
(system-objects-eqlp obj1-v obj2-v etype))
(return nil)))
(when (zerop (nth dim-ptr dimensions))
(decf dim-ptr))
(decf (nth dim-ptr dimensions)))))
(t
;; NB: this would be a mater of a program deficiency, not of any
;; innate quality of the underlying system
(error "System is not prepared to determine equivalence ~
for objects of type ~S"
external-type))
))))))
If there would be criticism about how that function operates, I could be
glad to know, so as to resolve it.
Looking at it, now, I consider that the EXTERNAL-TYPE argument was required
for kluding onto the situation of an ALIEN numeric type -- alien type
representation, onto a native value. In no other case does it appear to be
used.
I am not sure, immediateley, of how system-objects-eqlp would need to be
revised, if to be applicable in lisp hosts being neither SBCL nor CMUCL.
Now that I have become aware of CFFI, I had thought that that function might
bear mentioning. I consider that CFFI would be an appropriate location for
that item of code, there.
As it was, I had implemented that function, to have it take care of what I
had wanted an EQLP function to do, on system objects.
Considering that EQLP implements a method using system-objects-eqlp, , I
might also request that the following would be added, with it, if that item
would be added to the CFFI sources:
#+TAL
(defmethod tal:eqlp ((obj1 alien-value) (obj2 alien-value))
(system-objects-eqlp obj1 obj2 (alien-value-type obj1)))
For what it's worth, EQLP uses an extension onto the MOP methods protocol,
so as to try and save some cycles when called on objects not of the same
type; that behavior might resemble something after some compiler
optimizations in CMUCL and SBCL; it would be operable in a
cross-MOP-enabled-platform manner.
For what it's worth, I intend to publish the source for EQLP and the
documentation for it, as part to a 'tal-base' system in the the Tioga
Auxiliary Library (TAL).
TAL will be provided in a source-tree to the Tioga project
http://www.common-lisp.net/project/tioga/
On release of it, notification should be made by way of the Tioga-announce
mailing list
http://common-lisp.net/mailman/listinfo/tioga-announce
I mention the above, upon my wanting to explain what the phantom EQLP
function is.
I consider that the behaviors of EQLP may be better explained of the
documentation for it, however. (The source-code and the documentation for
it are scheduled for release, but they are not yet available, at this
hour. )
In the top of it, EQLP is a particular equality-predicate function.
If that system-objects-eqlp function would appear to be applicable to the
CFFI project, I would be glad if that it could be useful. I would remove
it, then, removing it from the TAL codebase from which it was drawn. I
consider that it would be more suitably located, if somewhere onto CFFI,
more than if it was into a component to TAL.
--
Sean
Some code I had used as to double-check if systems-objects-eqlp was working
on stat objects. The following was defined onto SBCL.
(defun lstat-without-clos-intermediary (designator)
;; patched onto sb-posix:lstat
(sb-posix::with-alien-stat ext-stat-obj ()
(let ((r (sb-alien::alien-funcall
(sb-alien::extern-alien "lstat"
(function sb-alien::int sb-alien::c-string (* sb-posix::alien-stat)))
(namestring designator)
ext-stat-obj)))
(if (minusp r)
(simple-err 'sb-posix:syscall-error
"lstat on file ~S" designator)
(values ext-stat-obj)))))
(defparameter *stat-1*
(lstat-without-clos-intermediary "/etc/passwd"))
(defparameter *stat-2*
(lstat-without-clos-intermediary "/etc/passwd"))
(system-objects-eqlp *stat-1* *stat-2*
(alien-value-type *stat-1*))
More information about the cffi-devel
mailing list