From 51a8e53201f8883fbd093fe45936d98128a8a5fe Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Fri, 6 Jun 2003 21:59:30 +0000 Subject: [PATCH] r5062: return from san diego --- src/aggregates.lisp | 7 ++-- src/functions.lisp | 7 ++-- src/libraries.lisp | 7 ++-- src/objects.lisp | 7 ++-- src/os.lisp | 8 ++--- src/package.lisp | 9 +++-- src/primitives.lisp | 7 ++-- src/readmacros-mcl.lisp | 7 ++-- src/strings.lisp | 75 +++++++++++++++++++++++++++++++++-------- uffi.asd | 4 +-- 10 files changed, 88 insertions(+), 50 deletions(-) diff --git a/src/aggregates.lisp b/src/aggregates.lisp index 5080222..6ee0ac7 100644 --- a/src/aggregates.lisp +++ b/src/aggregates.lisp @@ -2,12 +2,12 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: aggregates.cl +;;;; Name: aggregates.lisp ;;;; Purpose: UFFI source to handle aggregate types ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: aggregates.lisp,v 1.6 2002/12/02 13:21:43 kevin Exp $ +;;;; $Id: aggregates.lisp,v 1.7 2003/06/06 21:59:18 kevin Exp $ ;;;; ;;;; This file, part of UFFI, 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 :uffi) +(in-package #:uffi) (defmacro def-enum (enum-name args &key (separator-string "#")) "Creates a constants for a C type enum list, symbols are created diff --git a/src/functions.lisp b/src/functions.lisp index 600603d..9469945 100644 --- a/src/functions.lisp +++ b/src/functions.lisp @@ -2,12 +2,12 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: function.cl +;;;; Name: function.lisp ;;;; Purpose: UFFI source to C function definitions ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: functions.lisp,v 1.7 2003/02/06 06:54:22 kevin Exp $ +;;;; $Id: functions.lisp,v 1.8 2003/06/06 21:59:18 kevin Exp $ ;;;; ;;;; This file, part of UFFI, 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 :uffi) +(in-package #:uffi) (defun process-function-args (args) (if (null args) diff --git a/src/libraries.lisp b/src/libraries.lisp index 56829a0..1344d9d 100644 --- a/src/libraries.lisp +++ b/src/libraries.lisp @@ -2,12 +2,12 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: libraries.cl +;;;; Name: libraries.lisp ;;;; Purpose: UFFI source to load foreign libraries ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: libraries.lisp,v 1.6 2002/11/20 21:01:31 kevin Exp $ +;;;; $Id: libraries.lisp,v 1.7 2003/06/06 21:59:18 kevin Exp $ ;;;; ;;;; This file, part of UFFI, 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 :uffi) +(in-package #:uffi) (defvar *loaded-libraries* nil "List of foreign libraries loaded. Used to prevent reloading a library") diff --git a/src/objects.lisp b/src/objects.lisp index 51a9ce5..cb6cd7f 100644 --- a/src/objects.lisp +++ b/src/objects.lisp @@ -2,12 +2,12 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: objects.cl +;;;; Name: objects.lisp ;;;; Purpose: UFFI source to handle objects and pointers ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: objects.lisp,v 1.12 2003/05/30 18:46:45 kevin Exp $ +;;;; $Id: objects.lisp,v 1.13 2003/06/06 21:59:18 kevin Exp $ ;;;; ;;;; This file, part of UFFI, 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 :uffi) +(in-package #:uffi) (defun size-of-foreign-type (type) #+lispworks (fli:size-of type) diff --git a/src/os.lisp b/src/os.lisp index 918425c..3e3a60b 100644 --- a/src/os.lisp +++ b/src/os.lisp @@ -2,12 +2,12 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: os.cl +;;;; Name: os.lisp ;;;; Purpose: Operating system interface for UFFI ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Sep 2002 ;;;; -;;;; $Id: os.lisp,v 1.4 2002/10/23 19:51:20 kevin Exp $ +;;;; $Id: os.lisp,v 1.5 2003/06/06 21:59:18 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg. ;;;; Much of this code was taken from other open source project and copyright @@ -18,9 +18,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 :uffi) - +(in-package #:uffi) ;; modified from function ASDF -- Copyright Dan Barlow and Contributors diff --git a/src/package.lisp b/src/package.lisp index 1422638..9bd1b09 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -2,7 +2,7 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: package.cl +;;;; Name: package.lisp ;;;; Purpose: Defines UFFI package ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 @@ -14,11 +14,10 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0))) -(in-package :cl-user) +(in-package #:cl-user) -(defpackage :uffi - (:use :cl) +(defpackage #:uffi + (:use #:cl) (:export ;; immediate types diff --git a/src/primitives.lisp b/src/primitives.lisp index 0353066..1af37b4 100644 --- a/src/primitives.lisp +++ b/src/primitives.lisp @@ -2,12 +2,12 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: primitives.cl +;;;; Name: primitives.lisp ;;;; Purpose: UFFI source to handle immediate types ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: primitives.lisp,v 1.8 2002/12/15 17:11:08 kevin Exp $ +;;;; $Id: primitives.lisp,v 1.9 2003/06/06 21:59:18 kevin Exp $ ;;;; ;;;; This file, part of UFFI, 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 :uffi) +(in-package #:uffi) #+mcl (defvar *keyword-package* (find-package "KEYWORD")) diff --git a/src/readmacros-mcl.lisp b/src/readmacros-mcl.lisp index dc1fc6c..4eeffb2 100644 --- a/src/readmacros-mcl.lisp +++ b/src/readmacros-mcl.lisp @@ -2,12 +2,12 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: readmacros-mcl.cl +;;;; Name: readmacros-mcl.lisp ;;;; Purpose: This file holds functions using read macros for MCL ;;;; Programmer: Kevin M. Rosenberg/John Desoi ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: readmacros-mcl.lisp,v 1.3 2002/09/30 10:02:36 kevin Exp $ +;;;; $Id: readmacros-mcl.lisp,v 1.4 2003/06/06 21:59:18 kevin Exp $ ;;;; ;;;; This file, part of UFFI, 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 :uffi) +(in-package #:uffi) ;; trap macros don't work right directly in the macros diff --git a/src/strings.lisp b/src/strings.lisp index 28ff372..b4c1917 100644 --- a/src/strings.lisp +++ b/src/strings.lisp @@ -2,12 +2,12 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: strings.cl +;;;; Name: strings.lisp ;;;; Purpose: UFFI source to handle strings, cstring and foreigns ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: strings.lisp,v 1.7 2003/03/28 19:58:18 kevin Exp $ +;;;; $Id: strings.lisp,v 1.8 2003/06/06 21:59:18 kevin Exp $ ;;;; ;;;; This file, part of UFFI, 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 :uffi) +(in-package #:uffi) (defvar +null-cstring-pointer+ @@ -151,22 +150,27 @@ that LW/CMU automatically converts strings from c-calls." ;; Either length or null-terminated-p must be non-nil (defmacro convert-from-foreign-string (obj &key length + (locale :default) (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)))) + (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 - (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))) + (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) nil @@ -188,7 +192,6 @@ that LW/CMU automatically converts strings from c-calls." ) - (defmacro allocate-foreign-string (size &key (unsigned t)) #+(or cmu scl) (let ((array-def (gensym))) @@ -299,3 +302,47 @@ that LW/CMU automatically converts strings from c-calls." sb-vm:n-word-bits) (* 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)) diff --git a/uffi.asd b/uffi.asd index 40eb5be..515f52a 100644 --- a/uffi.asd +++ b/uffi.asd @@ -7,7 +7,7 @@ ;;;; Author: Kevin M. Rosenberg ;;;; Date Started: Aug 2002 ;;;; -;;;; $Id: uffi.asd,v 1.24 2003/04/29 12:09:36 kevin Exp $ +;;;; $Id: uffi.asd,v 1.25 2003/06/06 21:59:18 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -44,7 +44,7 @@ )) #+(or allegro lispworks cmu mcl cormanlisp sbcl scl) -(defmethod perform ((o test-op) (c (eql (find-system :uffi)))) +(defmethod perform ((o test-op) (c (eql (find-system 'uffi)))) (oos 'load-op 'uffi-tests) (oos 'test-op 'uffi-tests)) -- 2.34.1