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*))