X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=uffi%2Fclsql-uffi.lisp;h=fabf38ab61bee0c871acae61bc00bb710fe1e88f;hb=4c546104164756996a06705aa45233e98e2c2daa;hp=1b6153b3f4ef54447958f4a50effb453595c97e7;hpb=e512cb4708d197091317a2c7850a77710c1dda74;p=clsql.git diff --git a/uffi/clsql-uffi.lisp b/uffi/clsql-uffi.lisp index 1b6153b..fabf38a 100644 --- a/uffi/clsql-uffi.lisp +++ b/uffi/clsql-uffi.lisp @@ -7,7 +7,7 @@ ;;;; Programmers: Kevin M. Rosenberg ;;;; Date Started: Mar 2002 ;;;; -;;;; $Id: clsql-uffi.lisp,v 1.20 2003/05/16 18:53:57 kevin Exp $ +;;;; $Id: clsql-uffi.lisp,v 1.28 2003/05/29 05:19:50 kevin Exp $ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -16,8 +16,7 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0))) -(in-package :clsql-uffi) +(in-package #:clsql-uffi) (defun canonicalize-type-list (types auto-list) @@ -95,7 +94,7 @@ (declare (type char-ptr-def char-ptr)) (let ((char (uffi:ensure-char-character (uffi:deref-pointer char-ptr :char)))) - (eql char #\N))) + (char-equal char #\N))) (defun convert-raw-field (char-ptr types index) (let ((type (if (listp types) @@ -120,17 +119,15 @@ low32 (make-64-bit-integer high32 low32))))) (t - ;; Choose optimized routine - #-(or cmu sbcl) - (native-to-string char-ptr) - #+(or cmu sbcl) - (uffi:convert-from-foreign-string char-ptr))))))) + #+(or allegro lispworks) (native-to-string char-ptr) ;; optimized + #-(or allegro lispworks) (uffi:convert-from-foreign-string char-ptr))))))) (uffi:def-function "strlen" ((str (* :unsigned-char))) :returning :unsigned-int) +#+(or lispworks (and allegro ics)) (defun native-to-string (s) (declare (optimize (speed 3) (space 0) (safety 0) (compilation-speed 0)) (type char-ptr-def s)) @@ -146,23 +143,7 @@ (incf i)) str)) -#+(and allegro ics) -(defun native-to-string (s) - (declare (optimize (speed 3) (space 0) (safety 0) (compilation-speed 0)) - (type char-ptr-def s)) - (let* ((len (strlen s)) - (str (make-string len))) - (declare (fixnum len) - (simple-string str)) - (do ((i 0)) - ((= i len)) - (declare (fixnum i)) - (setf (schar str i) - (code-char (uffi:deref-array s '(:array :unsigned-char) i))) - (incf i)) - str)) - -#-(and allegro ics) +#+(and allegro (not ics)) (defun native-to-string (s) (declare (optimize (speed 3) (space 0) (safety 0) (compilation-speed 0)) (type char-ptr-def s)) @@ -184,6 +165,3 @@ (uffi:deref-array s '(:array :unsigned-char) i)) (incf i)) str)) - - -