uffi/src aggregates.lisp,1.6,1.7 functions.lisp,1.7,1.8 libraries.lisp,1.6,1.7 objects.lisp,1.12,1.13 os.lisp,1.4,1.5 package.lisp,1.3,1.4 primitives.lisp,1.8,1.9 readmacros-mcl.lisp,1.3,1.4 strings.lisp,1.7,1.8
"Kevin M. Rosenberg" <[email protected]> Fri, 6 Jun 2003 15:59:20 -0600
| Newsgroups | gmane.lisp.uffi.cvs |
|---|---|
| Message-ID | <[email protected]> |
Update of /pubcvs/uffi/src
In directory boa.b9.com:/tmp/cvs-serv10400/src
Modified Files:
aggregates.lisp functions.lisp libraries.lisp objects.lisp
os.lisp package.lisp primitives.lisp readmacros-mcl.lisp
strings.lisp
Log Message:
return from san diego
Index: aggregates.lisp
===================================================================
RCS file: /pubcvs/uffi/src/aggregates.lisp,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** aggregates.lisp 2 Dec 2002 13:21:43 -0000 1.6
--- aggregates.lisp 6 Jun 2003 21:59:18 -0000 1.7
***************
*** 3,7 ****
;;;; FILE IDENTIFICATION
;;;;
! ;;;; Name: aggregates.cl
;;;; Purpose: UFFI source to handle aggregate types
;;;; Programmer: Kevin M. Rosenberg
--- 3,7 ----
;;;; FILE IDENTIFICATION
;;;;
! ;;;; Name: aggregates.lisp
;;;; Purpose: UFFI source to handle aggregate types
;;;; Programmer: Kevin M. Rosenberg
***************
*** 17,22 ****
;;;; *************************************************************************
! (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
! (in-package :uffi)
(defmacro def-enum (enum-name args &key (separator-string "#"))
--- 17,21 ----
;;;; *************************************************************************
! (in-package #:uffi)
(defmacro def-enum (enum-name args &key (separator-string "#"))
Index: functions.lisp
===================================================================
RCS file: /pubcvs/uffi/src/functions.lisp,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** functions.lisp 6 Feb 2003 06:54:22 -0000 1.7
--- functions.lisp 6 Jun 2003 21:59:18 -0000 1.8
***************
*** 3,7 ****
;;;; FILE IDENTIFICATION
;;;;
! ;;;; Name: function.cl
;;;; Purpose: UFFI source to C function definitions
;;;; Programmer: Kevin M. Rosenberg
--- 3,7 ----
;;;; FILE IDENTIFICATION
;;;;
! ;;;; Name: function.lisp
;;;; Purpose: UFFI source to C function definitions
;;;; Programmer: Kevin M. Rosenberg
***************
*** 17,22 ****
;;;; *************************************************************************
! (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
! (in-package :uffi)
(defun process-function-args (args)
--- 17,21 ----
;;;; *************************************************************************
! (in-package #:uffi)
(defun process-function-args (args)
Index: libraries.lisp
===================================================================
RCS file: /pubcvs/uffi/src/libraries.lisp,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** libraries.lisp 20 Nov 2002 21:01:31 -0000 1.6
--- libraries.lisp 6 Jun 2003 21:59:18 -0000 1.7
***************
*** 3,7 ****
;;;; FILE IDENTIFICATION
;;;;
! ;;;; Name: libraries.cl
;;;; Purpose: UFFI source to load foreign libraries
;;;; Programmer: Kevin M. Rosenberg
--- 3,7 ----
;;;; FILE IDENTIFICATION
;;;;
! ;;;; Name: libraries.lisp
;;;; Purpose: UFFI source to load foreign libraries
;;;; Programmer: Kevin M. Rosenberg
***************
*** 17,22 ****
;;;; *************************************************************************
! (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
! (in-package :uffi)
(defvar *loaded-libraries* nil
--- 17,21 ----
;;;; *************************************************************************
! (in-package #:uffi)
(defvar *loaded-libraries* nil
Index: objects.lisp
===================================================================
RCS file: /pubcvs/uffi/src/objects.lisp,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -d -r1.12 -r1.13
*** objects.lisp 30 May 2003 18:46:45 -0000 1.12
--- objects.lisp 6 Jun 2003 21:59:18 -0000 1.13
***************
*** 3,7 ****
;;;; FILE IDENTIFICATION
;;;;
! ;;;; Name: objects.cl
;;;; Purpose: UFFI source to handle objects and pointers
;;;; Programmer: Kevin M. Rosenberg
--- 3,7 ----
;;;; FILE IDENTIFICATION
;;;;
! ;;;; Name: objects.lisp
;;;; Purpose: UFFI source to handle objects and pointers
;;;; Programmer: Kevin M. Rosenberg
***************
*** 17,22 ****
;;;; *************************************************************************
! (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
! (in-package :uffi)
(defun size-of-foreign-type (type)
--- 17,21 ----
;;;; *************************************************************************
! (in-package #:uffi)
(defun size-of-foreign-type (type)
Index: os.lisp
===================================================================
RCS file: /pubcvs/uffi/src/os.lisp,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** os.lisp 23 Oct 2002 19:51:20 -0000 1.4
--- os.lisp 6 Jun 2003 21:59:18 -0000 1.5
***************
*** 3,7 ****
;;;; FILE IDENTIFICATION
;;;;
! ;;;; Name: os.cl
;;;; Purpose: Operating system interface for UFFI
;;;; Programmer: Kevin M. Rosenberg
--- 3,7 ----
;;;; FILE IDENTIFICATION
;;;;
! ;;;; Name: os.lisp
;;;; Purpose: Operating system interface for UFFI
;;;; Programmer: Kevin M. Rosenberg
***************
*** 19,25 ****
;;;; *************************************************************************
! (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
! (in-package :uffi)
!
;; modified from function ASDF -- Copyright Dan Barlow and Contributors
--- 19,23 ----
;;;; *************************************************************************
! (in-package #:uffi)
;; modified from function ASDF -- Copyright Dan Barlow and Contributors
Index: package.lisp
===================================================================
RCS file: /pubcvs/uffi/src/package.lisp,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** package.lisp 14 Oct 2002 03:07:41 -0000 1.3
--- package.lisp 6 Jun 2003 21:59:18 -0000 1.4
***************
*** 3,7 ****
;;;; FILE IDENTIFICATION
;;;;
! ;;;; Name: package.cl
;;;; Purpose: Defines UFFI package
;;;; Programmer: Kevin M. Rosenberg
--- 3,7 ----
;;;; FILE IDENTIFICATION
;;;;
! ;;;; Name: package.lisp
;;;; Purpose: Defines UFFI package
;;;; Programmer: Kevin M. Rosenberg
***************
*** 15,23 ****
;;;; *************************************************************************
! (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
! (in-package :cl-user)
! (defpackage :uffi
! (:use :cl)
(:export
--- 15,22 ----
;;;; *************************************************************************
! (in-package #:cl-user)
! (defpackage #:uffi
! (:use #:cl)
(:export
Index: primitives.lisp
===================================================================
RCS file: /pubcvs/uffi/src/primitives.lisp,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** primitives.lisp 15 Dec 2002 17:11:08 -0000 1.8
--- primitives.lisp 6 Jun 2003 21:59:18 -0000 1.9
***************
*** 3,7 ****
;;;; FILE IDENTIFICATION
;;;;
! ;;;; Name: primitives.cl
;;;; Purpose: UFFI source to handle immediate types
;;;; Programmer: Kevin M. Rosenberg
--- 3,7 ----
;;;; FILE IDENTIFICATION
;;;;
! ;;;; Name: primitives.lisp
;;;; Purpose: UFFI source to handle immediate types
;;;; Programmer: Kevin M. Rosenberg
***************
*** 17,22 ****
;;;; *************************************************************************
! (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
! (in-package :uffi)
#+mcl
--- 17,21 ----
;;;; *************************************************************************
! (in-package #:uffi)
#+mcl
Index: readmacros-mcl.lisp
===================================================================
RCS file: /pubcvs/uffi/src/readmacros-mcl.lisp,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** readmacros-mcl.lisp 30 Sep 2002 10:02:36 -0000 1.3
--- readmacros-mcl.lisp 6 Jun 2003 21:59:18 -0000 1.4
***************
*** 3,7 ****
;;;; FILE IDENTIFICATION
;;;;
! ;;;; Name: readmacros-mcl.cl
;;;; Purpose: This file holds functions using read macros for MCL
;;;; Programmer: Kevin M. Rosenberg/John Desoi
--- 3,7 ----
;;;; FILE IDENTIFICATION
;;;;
! ;;;; Name: readmacros-mcl.lisp
;;;; Purpose: This file holds functions using read macros for MCL
;;;; Programmer: Kevin M. Rosenberg/John Desoi
***************
*** 17,22 ****
;;;; *************************************************************************
! (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
! (in-package :uffi)
--- 17,21 ----
;;;; *************************************************************************
! (in-package #:uffi)
Index: strings.lisp
===================================================================
RCS file: /pubcvs/uffi/src/strings.lisp,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** strings.lisp 28 Mar 2003 19:58:18 -0000 1.7
--- strings.lisp 6 Jun 2003 21:59:18 -0000 1.8
***************
*** 3,7 ****
;;;; FILE IDENTIFICATION
;;;;
! ;;;; Name: strings.cl
;;;; Purpose: UFFI source to handle strings, cstring and foreigns
;;;; Programmer: Kevin M. Rosenberg
--- 3,7 ----
;;;; FILE IDENTIFICATION
;;;;
! ;;;; Name: strings.lisp
;;;; Purpose: UFFI source to handle strings, cstring and foreigns
;;;; Programmer: Kevin M. Rosenberg
***************
*** 17,22 ****
;;;; *************************************************************************
! (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
! (in-package :uffi)
--- 17,21 ----
;;;; *************************************************************************
! (in-package #:uffi)
***************
*** 152,171 ****
(defmacro convert-from-foreign-string (obj &key
length
(null-terminated-p t))
#+allegro
`(if (zerop ,obj)
nil
! (values (excl:native-to-string
! ,obj
! ,@(if length (list :length length) (values))
! :truncate (not ,null-terminated-p))))
#+lispworks
`(if (fli:null-pointer-p ,obj)
nil
! (fli:convert-from-foreign-string
! ,obj
! ,@(if length (list :length length) (values))
! :null-terminated-p ,null-terminated-p
! :external-format '(:latin-1 :eol-style :lf)))
#+(or cmu scl)
`(if (null-pointer-p ,obj)
--- 151,175 ----
(defmacro convert-from-foreign-string (obj &key
length
+ (locale :default)
(null-terminated-p t))
#+allegro
`(if (zerop ,obj)
nil
! (if (eq ,locale :none)
! (fast-native-to-string ,obj)
! (excl:native-to-string
! ,obj
! ,@(when length (list :length length))
! :truncate (not ,null-terminated-p))))
#+lispworks
`(if (fli:null-pointer-p ,obj)
nil
! (if (eq ,locale :none)
! (fast-native-to-string ,obj)
! (fli:convert-from-foreign-string
! ,obj
! ,@(when length (list :length length))
! :null-terminated-p ,null-terminated-p
! :external-format '(:latin-1 :eol-style :lf))))
#+(or cmu scl)
`(if (null-pointer-p ,obj)
***************
*** 189,193 ****
-
(defmacro allocate-foreign-string (size &key (unsigned t))
#+(or cmu scl)
--- 193,196 ----
***************
*** 300,301 ****
--- 303,348 ----
(* length sb-vm:n-byte-bits))
result)))
+
+
+ (def-function "strlen"
+ ((str (* :unsigned-char)))
+ :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))
+ (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 (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))