uffi/src strings.lisp,1.8,1.9

Update of /pubcvs/uffi/src
In directory boa.b9.com:/tmp/cvs-serv20987/debian/src/uffi/src

Modified Files:
	strings.lisp 
Log Message:


Index: strings.lisp
===================================================================
RCS file: /pubcvs/uffi/src/strings.lisp,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** strings.lisp	6 Jun 2003 21:59:18 -0000	1.8
--- strings.lisp	12 Jun 2003 18:32:30 -0000	1.9
***************
*** 309,313 ****
    :returning :unsigned-int)
  
! #+(or lispworks (and allegro ics))
  (defun fast-native-to-string (s)
    (declare (optimize (speed 3) (space 0) (safety 0) (compilation-speed 0))
--- 309,316 ----
    :returning :unsigned-int)
  
! (def-type char-ptr-def (* :unsigned-char))
! 
! ;;#+(or lispworks (and allegro ics))
! #+(or lispworks allegro)
  (defun fast-native-to-string (s)
    (declare (optimize (speed 3) (space 0) (safety 0) (compilation-speed 0))
***************
*** 316,348 ****
  	 (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 (not ics))
  (defun fast-native-to-string (s)
!   (declare (optimize (speed 3) (space 0) (safety 0) (compilation-speed 0))
  	   (type char-ptr-def s))
    (let* ((len (strlen s))
! 	 (len4 (floor len 4))
! 	 (str (make-string len)))
!     (declare (fixnum len)
! 	     (type (simple-array (signed-byte 32) (*)) str))
!     (do ((i 0))
! 	((= i len4))
        (declare (fixnum i))
!       (setf (aref (the (simple-array (signed-byte 32) (*)) str) i)
! 	(uffi:deref-array s '(:array :int) i))
! 	(incf i))
!     (do ((i (* 4 len4)))
! 	((= i len))
        (declare (fixnum i))
!       (setf (aref (the (simple-array (signed-byte 8) (*)) str) i)
! 	(uffi:deref-array s '(:array :unsigned-char) i))
!       (incf i))
      str))
--- 319,346 ----
  	 (str (make-string len)))
      (declare (fixnum len)
! 	     (type (simple-array (signed-byte 8) (*)) str))
!     (dotimes (i len str)
!       (setf (aref str i) (uffi:deref-array s '(:array :char) i)))))
  
! ;;#+(and allegro (not ics))
! #+ignore
  (defun fast-native-to-string (s)
!   (declare (optimize (speed 3) (space 0) (safety 0) (compilation-speed 0) (debug 0))
  	   (type char-ptr-def s))
    (let* ((len (strlen s))
! 	 (len4 (the fixnum (ash (the fixnum len) -2)))
! 	 (end4 (the fixnum (ash (the fixnum len4) 2)))
! 	 (remainder (the fixnum (- len end4)))
! 	 (str (make-string len))
! 	 (str4 str))
!     (declare (type fixnum len len4 end4 remainder)
! 	     (type (simple-array (signed-byte 32) (*)) str4)
! 	     (type (simple-array (signed-byte 8) (*)) str))
!     (dotimes (i len4)
        (declare (fixnum i))
!       (setf (aref str4 i) (uffi:deref-array s '(:array :int) i)))
!     (dotimes (i remainder)
        (declare (fixnum i))
!       (setf (aref str end4) (uffi:deref-array s '(:array :char) end4))
!       (incf end4))
      str))