Update of /project/elephant/cvsroot/elephant/src/memutil In directory clnet:/tmp/cvs-serv1238/src/memutil
Modified Files: memutil.lisp Log Message: Tweaks for lispworks compatability
--- /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp 2007/02/14 04:36:13 1.23 +++ /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp 2007/02/26 19:12:19 1.24 @@ -79,7 +79,7 @@ (def-type pointer-int (* :int)) (def-type pointer-void :pointer-void) (def-foreign-type array-or-pointer-char - #+allegro (:array :unsigned-char) + #+(or allegro lispworks) (:array :unsigned-char) #+(or cmu sbcl scl openmcl) (* :unsigned-char)) (def-type array-or-pointer-char array-or-pointer-char)
@@ -828,8 +828,9 @@ ;; This code is an attempt to allow compilation under bothe SBCL 8 and SBCL 9. ;; Thanks to Juho Snellman for this idiom. (eval-when (:compile-toplevel) + #+(and sbcl sb-unicode) (defun new-style-copy-p () - (if (find-symbol "COPY-UB8-FROM-SYSTEM-AREA" "SB-KERNEL") + (if (find-symbol "COPY-UB8-FROM-SYSTEM-AREA" "SB-KERNEL") '(:and) '(:or))) ) @@ -846,14 +847,14 @@ :length byte-length :null-terminated-p nil) #+(and sbcl sb-unicode) (let ((res (make-string byte-length :element-type 'base-char))) -#+#.(elephant-memutil::new-style-copy-p) + #+#.(elephant-memutil::new-style-copy-p) (sb-kernel:copy-ub8-from-system-area (sb-alien:alien-sap (buffer-stream-buffer bs)) position res 0 byte-length) -#-#.(elephant-memutil::new-style-copy-p) + #-#.(elephant-memutil::new-style-copy-p) (sb-kernel:copy-from-system-area (sb-alien:alien-sap (buffer-stream-buffer bs)) (* position sb-vm:n-byte-bits) @@ -888,14 +889,14 @@ (let ((position (buffer-stream-position bs))) (setf (buffer-stream-position bs) (+ position byte-length)) (let ((res (make-string (/ byte-length 4) :element-type 'character))) -#+#.(elephant-memutil::new-style-copy-p) + #+#.(elephant-memutil::new-style-copy-p) (sb-kernel:copy-ub8-from-system-area (sb-alien:alien-sap (buffer-stream-buffer bs)) position res 0 byte-length) -#-#.(elephant-memutil::new-style-copy-p) + #-#.(elephant-memutil::new-style-copy-p) (sb-kernel:copy-from-system-area (sb-alien:alien-sap (buffer-stream-buffer bs)) (* position sb-vm:n-byte-bits)