r1581: *** empty log message ***

diff --git a/ChangeLog b/ChangeLog
index c8e9e1d59adf3476f6d805b22947f3fa1d8f24bb..cc08f36686601ec08b7e5da24b15bcd4ff35eaaf 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,4 +1,13 @@
-16 Mar
+17 Mar 2002
+       * Changed deref-pointer so it always returns a character when
+       called with a :char or :unsigned-char type
+       * Removed function ensure-char as no longer needed
+       * Added missing :byte specifier to Lispworks
+       * Changed default string type in Lispworks to :unsigned-char
+       which is the native type for Lispworks foreign-strings.
+       * Reworked strtol to handle new character pointing method
+       
+16 Mar 2002
        * Fixed return value in load-foreign-library (Thanks Erik Winkels),
        modified routine to accept pathnames as well as strings.
        * Fix documention with :pointer-void (Again, Erik Winkels)

diff --git a/Makefile b/Makefile
index 5cd436d463fce9f2a25c633e263a51dc36b3bf5c..2d8f5031adea621b5691d074ba4f4749380c6919 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -5,7 +5,7 @@
 #  Programer:    Kevin M. Rosenberg, M.D.
 #  Date Started: Mar 2002
 #
-#  CVS Id:   $Id: Makefile,v 1.18 2002/03/15 19:26:11 kevin Exp $
+#  CVS Id:   $Id: Makefile,v 1.19 2002/03/17 17:33:30 kevin Exp $
 #
 # This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 #
@@ -31,7 +31,7 @@ realclean: clean
 docs:
        @(cd doc; make dist-doc)
 
-VERSION=0.2.7
+VERSION=0.2.8
 DISTDIR=uffi-${VERSION}
 DIST_TARBALL=${DISTDIR}.tar.gz
 DIST_ZIP=${DISTDIR}.zip

diff --git a/doc/ref.sgml b/doc/ref.sgml
index 46f91a5f40fbc037a1ef6b5f35c6df46dabd3bbd..2eb2e1c438ca9bae4c460e9b8b29afba26bcf5e0 100644 (file)
--- a/doc/ref.sgml
+++ b/doc/ref.sgml
@@ -88,43 +88,55 @@
        </para>
        <itemizedlist>
          <listitem>
-           <para><constant>:char</constant> - Signed 8-bits</para>
+           <para><constant>:char</constant> - Signed 8-bits. A
+dereferenced :char pointer returns an character.</para>
+</para>
          </listitem>
          <listitem>
-           <para><constant>:unsigned-char</constant> - Unsigned 8-bits</para>
+           <para><constant>:unsigned-char</constant> - Unsigned 8-bits. A dereferenced :unsigned-char
+pointer returns an character.</para>
          </listitem>
          <listitem>
-           <para><constant>:short</constant> - Signed 16-bits</para>
+         <listitem>
+           <para><constant>:byte</constant> - Unsigned 8-bits. A
+dereferenced :byte pointer returns an integer.</para>
+         </listitem>
+         <listitem>
+           <para><constant>:short</constant> - Signed 16-bits.</para>
          </listitem>
          <listitem>
-           <para><constant>:unsigned-short</constant> - Unsigned 16-bits</para>
+           <para><constant>:unsigned-short</constant> - Unsigned 16-bits.</para>
          </listitem>
          <listitem>
-           <para><constant>:int</constant> - Signed 32-bits</para>
+           <para><constant>:int</constant> - Signed 32-bits.</para>
          </listitem>
          <listitem>
-           <para><constant>:unsigned-int</constant> - Unsigned 32-bits</para>
+           <para><constant>:unsigned-int</constant> - Unsigned 32-bits.</para>
          </listitem>
          <listitem>
-           <para><constant>:long</constant> - Signed 32-bits</para>
+           <para><constant>:long</constant> - Signed 32-bits.</para>
          </listitem>
          <listitem>
-           <para><constant>:unsigned-long</constant> - Unsigned 32-bits</para>
+           <para><constant>:unsigned-long</constant> - Unsigned 32-bits.</para>
          </listitem>
          <listitem>
-           <para><constant>:float</constant> - 32-bit floating point</para>
+           <para><constant>:float</constant> - 32-bit floating point.</para>
          </listitem>
          <listitem>
-           <para><constant>:double</constant> - 64-bit floating point</para>
+           <para><constant>:double</constant> - 64-bit floating point.</para>
          </listitem>
          <listitem>
            <para><constant>:cstring</constant> - 
-A null-terminated string used for passing and returning with a function.
+A &null; terminated string used for passing and returning characters strings with a &c; function.
            </para>
          </listitem>
          <listitem>
            <para><constant>:void</constant> - 
-The absence of a value. Used in generic pointers and in return types from functions.</para>
+The absence of a value. Used to indicate that a function does not return a value.</para>
+         </listitem>
+         <listitem>
+           <para><constant>:pointer-void</constant> - 
+Points to a generic object.</para>
          </listitem>
          <listitem>
            <para><constant>*</constant> - Used to declare a pointer to an object</para>
@@ -327,86 +339,20 @@ abstracts the difference in implementations where some return a
        <para>None.</para>
       </refsect1>
     </refentry>
+  </reference>
 
-    <refentry id="ensure-char">
-      <refnamediv>
-       <refname>ensure-char</refname>
-       <refpurpose>Ensures value is a character.
-       </refpurpose>
-       <refclass>Macro</refclass>
-      </refnamediv>
-      <refsynopsisdiv>
-       <title>Syntax</title>
-       <synopsis>
-         <function>ensure-char</function> <replaceable>obj</replaceable> => <returnvalue>char</returnvalue>
-       </synopsis>
-      </refsynopsisdiv>
-      <refsect1>
-       <title>Arguments and Values</title>
-       <variablelist>
-         <varlistentry>
-           <term><parameter>obj</parameter></term>
-           <listitem>
-             <para>A character or integer.
-             </para>
-           </listitem>
-         </varlistentry>
-         <varlistentry>
-           <term><parameter>char</parameter></term>
-           <listitem>
-             <para>A character value.
-             </para>
-           </listitem>
-         </varlistentry>
-       </variablelist>
-      </refsect1>
-      <refsect1>
-       <title>Description</title>
-       <para>
-         Enscapsulates the fact that some implementations return a character
-and others return an integer when dereferencing a character pointer.
-       </para>
-      </refsect1>
-      <refsect1>
-       <title>Examples</title>
-       <para>
-<programlisting>
-(let ((fs (convert-to-foreign-string "a")))
-  (prog1 
-    (ensure-char (deref-pointer fs :char))
-    (free-foreign-object fs)))
-=> #\a
-</programlisting>
-       </para>
-      </refsect1>
-      <refsect1>
-       <title>Side Effects</title>
-       <para>None.</para>
-      </refsect1>
-      <refsect1>
-       <title>Affected by</title>
-       <para>None.</para>
-      </refsect1>
-      <refsect1>
-       <title>Exceptional Situations</title>
-       <para>Signals an error if <parameter>obj</parameter> is not
-an integer or character.</para>
-      </refsect1>
-    </refentry>
-</reference>
-
-<reference>
-      <title>Aggregate Types</title>
+  <reference>
+    <title>Aggregate Types</title>
     <partintro>
       <title>Overview</title>
       <para>
        Aggregate types are comprised of one or more primitive types.
       </para>
-</partintro>
+    </partintro>
 
-      <refentry id="def-enum">
-       <refnamediv>
-         <refname>def-enum</refname>
+    <refentry id="def-enum">
+      <refnamediv>
+       <refname>def-enum</refname>
        <refpurpose>Defines a &c; enumeration.
        </refpurpose>
        <refclass>Macro</refclass>
@@ -1599,7 +1545,7 @@ Can translated ASCII and binary strings.
          <varlistentry>
            <term><parameter>unsigned</parameter></term>
            <listitem>
-             <para>A boolean flag with a default value of &nil;. When true,
+             <para>A boolean flag with a default value of &t;. When true,
 marks the pointer as an <constant>:unsigned-char</constant>.
              </para>
            </listitem>
@@ -1665,7 +1611,7 @@ marks the pointer as an <constant>:unsigned-char</constant>.
          <varlistentry>
            <term><parameter>args</parameter></term>
            <listitem>
-             <para>A list of argument declarations. Use &nil; to specify no arguments.
+             <para>A list of argument declarations. If &nil;, indicates that the function does not take any arguments.
              </para>
            </listitem>
          </varlistentry>
@@ -1679,7 +1625,7 @@ marks the pointer as an <constant>:unsigned-char</constant>.
            <term><returnvalue>returning</returnvalue></term>
            <listitem>
              <para>A declaration specifying the result type of the
-foreign function.
+foreign function. If <constant>:void</constant> indicates module does not return any value.
              </para>
            </listitem>
          </varlistentry>

diff --git a/examples/compress.cl b/examples/compress.cl
index e077e0ab242a627317bf18f46486894c5270e61e..c45029de8637213045c76c69fd21418812c03aed 100644 (file)
--- a/examples/compress.cl
+++ b/examples/compress.cl
@@ -1,4 +1,4 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; -*- Mode: ANSI-Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: compress.cl,v 1.7 2002/03/14 21:03:12 kevin Exp $
+;;;; $Id: compress.cl,v 1.8 2002/03/17 17:33:30 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;

diff --git a/examples/strtol.cl b/examples/strtol.cl
index 8f52638bf0d744e51909b10dd4bc656b9217568e..63aea44fb8546fa1a627f193fb44f78e62c78f37 100644 (file)
--- a/examples/strtol.cl
+++ b/examples/strtol.cl
@@ -1,4 +1,4 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; -*- Mode: ANSI-Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: strtol.cl,v 1.8 2002/03/14 21:03:12 kevin Exp $
+;;;; $Id: strtol.cl,v 1.9 2002/03/17 17:33:30 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -18,14 +18,14 @@
 
 (in-package :cl-user)
 
-(uffi:def-foreign-type char-ptr (* :char))
+(uffi:def-foreign-type char-ptr (* :unsigned-char))
   
 ;; This example does not use :cstring to pass the input string since
 ;; the routine needs to do pointer arithmetic to see how many characters
 ;; were parsed
 
 (uffi:def-function ("strtol" c-strtol) 
-    ((nptr (* :char))
+    ((nptr char-ptr)
      (endptr (* char-ptr))
      (base :int))
   :returning :long)
@@ -39,20 +39,27 @@ of first non-valid character"
         (endptr (uffi:allocate-foreign-object char-ptr))
         (value (c-strtol str-native endptr base))
         (endptr-value (uffi:deref-pointer endptr 'char-ptr))
-        (next-char-value (uffi:deref-pointer endptr-value :char))
-        (chars-parsed (- (uffi:pointer-address endptr-value)
-                         (uffi:pointer-address str-native))))
-    (uffi:free-foreign-object str-native)
-    (uffi:free-foreign-object endptr)
-    (cond
-     ((zerop chars-parsed)
-      (values nil nil))
-     ((uffi:null-char-p next-char-value)
-      (values value t))
-     (t
-      (values value chars-parsed)))))
+        next-char-value chars-parsed)
 
+    (unwind-protect
+        (if (uffi:null-pointer-p endptr-value)
+            (values value t)
+            (let ((next-char-value (uffi:deref-pointer endptr-value :unsigned-char))
+                  (chars-parsed (- (uffi:pointer-address endptr-value)
+                                   (uffi:pointer-address str-native))))
+              (cond
+                ((zerop chars-parsed)
+                 (values nil nil))
+                ((uffi:null-char-p next-char-value)
+                 (values value t))
+                (t
+                 (values value chars-parsed)))))
+      (progn
+       (uffi:free-foreign-object str-native)
+       (uffi:free-foreign-object endptr)))))
 
+ 
+  
 #+test-uffi
 (progn
   (flet ((print-results (str)

diff --git a/set-logical.cl b/set-logical.cl
index 48b6e4bbea6af5ee6425f35eb7748fc56e76b857..7c5d1271755a3d7d01e4e5beb8d1cbcfaabcbd73 100644 (file)
--- a/set-logical.cl
+++ b/set-logical.cl
@@ -1,4 +1,4 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; -*- Mode: ANSI-Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;

diff --git a/src/aggregates.cl b/src/aggregates.cl
index 1475bd9df7845d2fdc4dad568841a2b3d3b1f477..3bb97f9ae59f46c37cb94771bc3b24b16fa8608b 100644 (file)
--- a/src/aggregates.cl
+++ b/src/aggregates.cl
@@ -1,4 +1,4 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; -*- Mode: ANSI-Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: aggregates.cl,v 1.5 2002/03/14 21:32:23 kevin Exp $
+;;;; $Id: aggregates.cl,v 1.6 2002/03/17 17:33:30 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;

diff --git a/src/functions.cl b/src/functions.cl
index 62b1a491005147c896071d718af87ee9ca9ec781..4abb9516840d2ba04a6292800c5bff0aac04d456 100644 (file)
--- a/src/functions.cl
+++ b/src/functions.cl
@@ -1,4 +1,4 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; -*- Mode: ANSI-Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: functions.cl,v 1.2 2002/03/14 21:03:12 kevin Exp $
+;;;; $Id: functions.cl,v 1.3 2002/03/17 17:33:30 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;

diff --git a/src/objects.cl b/src/objects.cl
index 316a7eea35449397fa73703afeb71a4134f5b45b..0f28115a0cbd24565ad81b915475212994923d77 100644 (file)
--- a/src/objects.cl
+++ b/src/objects.cl
@@ -1,4 +1,4 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; -*- Mode: ANSI-Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: objects.cl,v 1.5 2002/03/14 21:03:12 kevin Exp $
+;;;; $Id: objects.cl,v 1.6 2002/03/17 17:33:30 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -54,11 +54,18 @@
 
 (defmacro deref-pointer (ptr type)
   "Returns a object pointed"
-  #+(or lispworks cmu) (declare (ignore type))
-  #+cmu  `(alien:deref ,ptr)
-  #+lispworks `(fli:dereference ,ptr)
-  #+allegro `(ff:fslot-value-typed ,type :c ,ptr)
-  )
+  (let ((result (gensym)))
+    `(let ((,result
+           #+cmu  (alien:deref ,ptr)
+           #+lispworks (fli:dereference ,ptr)
+           #+allegro (ff:fslot-value-typed ,type :c ,ptr)
+           ))
+      (if (and
+          (or (eq ,type :char)
+              (eq ,type :unsigned-char))
+          (numberp ,result))
+         (code-char ,result)
+         ,result))))
 
 (defmacro pointer-address (obj)
   #+cmu

diff --git a/src/primitives.cl b/src/primitives.cl
index 2555b4c5b0f2d28a9a1dae588c9b2f2897a0dc38..0048668d9779c1bd0289c9d4a6c2efcb03021950 100644 (file)
--- a/src/primitives.cl
+++ b/src/primitives.cl
@@ -1,4 +1,4 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; -*- Mode: ANSI-Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: primitives.cl,v 1.7 2002/03/16 22:54:06 kevin Exp $
+;;;; $Id: primitives.cl,v 1.8 2002/03/17 17:33:30 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -42,12 +42,6 @@ supports takes advantage of this optimization."
       t
     nil))
 
-(defmacro ensure-char (val)
-  `(etypecase ,val
-     (integer
-      (code-char ,val))
-     (character
-      ,val)))
       
 (defmacro def-foreign-type (name type)
   #+lispworks `(fli:define-c-typedef ,name ,(convert-from-uffi-type type :type))
@@ -94,7 +88,7 @@ supports takes advantage of this optimization."
     '((* . *) (:void . :void)
       (:short . :short)
       (:pointer-void . (* :void))
-      (:cstring . (* :char))
+      (:cstring . (* :unsigned-char))
       (:char . :char)
       (:unsigned-char . :unsigned-char)
       (:byte . :byte)
@@ -106,9 +100,10 @@ supports takes advantage of this optimization."
 (defconstant +type-conversion-list+
     '((* . :pointer) (:void . :void) 
       (:short . :short)
-      (:pointer-void . (:pointer :void))
-      (:cstring . (:pointer :char))
-      (:char . :char) 
+      (:pointer-void . (:pointer :unsigned :void))
+      (:cstring . (:pointer (:unsigned :char)))
+      (:char . :char)
+      (:byte :byte)
       (:unsigned-char . (:unsigned :char))
       (:int . :int) (:unsigned-int . (:unsigned :int))
       (:long . :long) (:unsigned-long . (:unsigned :long))

diff --git a/src/strings.cl b/src/strings.cl
index 0d1844e301eb05eb4fc4931e3ee0e25d8e032ff8..95fdadf3289e1f0d3e3b83433d34a842d663c4d8 100644 (file)
--- a/src/strings.cl
+++ b/src/strings.cl
@@ -1,4 +1,4 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; -*- Mode: ANSI-Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: strings.cl,v 1.5 2002/03/14 21:03:12 kevin Exp $
+;;;; $Id: strings.cl,v 1.6 2002/03/17 17:33:30 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -23,7 +23,7 @@
 (def-constant +null-cstring-pointer+
     #+cmu nil
     #+allegro 0
-    #+lispworks (fli:make-pointer :address 0 :type :char))
+    #+lispworks (fli:make-pointer :address 0 :type '(:unsigned :char)))
 
 (defmacro convert-from-cstring (obj)
   "Converts a string from a c-call. Same as convert-from-foreign-string, except
@@ -46,14 +46,12 @@ that CMU automatically converts strings from c-calls."
 (defmacro convert-to-cstring (obj)
   #+lispworks
   `(if (null ,obj)
-       +null-cstring-pointer+
-     (fli:make-pointer
-      :address (fli:pointer-address (fli:convert-to-foreign-string ,obj))
-      :type :char))
+    +null-cstring-pointer+
+    (fli:convert-to-foreign-string ,obj))
   #+allegro
   `(if (null ,obj)
-       0
-     (values (excl:string-to-native ,obj)))
+    0
+    (values (excl:string-to-native ,obj)))
   #+cmu
   (declare (ignore obj))
   )
@@ -98,9 +96,7 @@ that CMU automatically converts strings from c-calls."
   #+lispworks
   `(if (null ,obj)
        +null-cstring-pointer+
-     (fli:make-pointer
-      :address (fli:pointer-address (fli:convert-to-foreign-string ,obj))
-      :type :char))
+    (fli:convert-to-foreign-string ,obj))
   #+allegro
   `(if (null ,obj)
        0
@@ -122,7 +118,7 @@ that CMU automatically converts strings from c-calls."
   )
 
 
-(defmacro allocate-foreign-string (size &key (unsigned nil))
+(defmacro allocate-foreign-string (size &key (unsigned t))
   #+cmu
   (let ((array-def (gensym)))
     `(let ((,array-def (list 'alien:array 'c-call:char ,size)))

diff --git a/test-examples.cl b/test-examples.cl
index 0c33bb2639fb9e5193542e0d1e1c9b2cd7db78f3..c8fa0ac449279a419a3660895dadf7793983eced 100644 (file)
--- a/test-examples.cl
+++ b/test-examples.cl
@@ -1,4 +1,4 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; -*- Mode: ANSI-Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: test-examples.cl,v 1.3 2002/03/16 22:54:06 kevin Exp $
+;;;; $Id: test-examples.cl,v 1.4 2002/03/17 17:33:30 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;

diff --git a/tests/compress.cl b/tests/compress.cl
index e077e0ab242a627317bf18f46486894c5270e61e..c45029de8637213045c76c69fd21418812c03aed 100644 (file)
--- a/tests/compress.cl
+++ b/tests/compress.cl
@@ -1,4 +1,4 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; -*- Mode: ANSI-Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: compress.cl,v 1.7 2002/03/14 21:03:12 kevin Exp $
+;;;; $Id: compress.cl,v 1.8 2002/03/17 17:33:30 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;

diff --git a/tests/strtol.cl b/tests/strtol.cl
index 8f52638bf0d744e51909b10dd4bc656b9217568e..63aea44fb8546fa1a627f193fb44f78e62c78f37 100644 (file)
--- a/tests/strtol.cl
+++ b/tests/strtol.cl
@@ -1,4 +1,4 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; -*- Mode: ANSI-Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: strtol.cl,v 1.8 2002/03/14 21:03:12 kevin Exp $
+;;;; $Id: strtol.cl,v 1.9 2002/03/17 17:33:30 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -18,14 +18,14 @@
 
 (in-package :cl-user)
 
-(uffi:def-foreign-type char-ptr (* :char))
+(uffi:def-foreign-type char-ptr (* :unsigned-char))
   
 ;; This example does not use :cstring to pass the input string since
 ;; the routine needs to do pointer arithmetic to see how many characters
 ;; were parsed
 
 (uffi:def-function ("strtol" c-strtol) 
-    ((nptr (* :char))
+    ((nptr char-ptr)
      (endptr (* char-ptr))
      (base :int))
   :returning :long)
@@ -39,20 +39,27 @@ of first non-valid character"
         (endptr (uffi:allocate-foreign-object char-ptr))
         (value (c-strtol str-native endptr base))
         (endptr-value (uffi:deref-pointer endptr 'char-ptr))
-        (next-char-value (uffi:deref-pointer endptr-value :char))
-        (chars-parsed (- (uffi:pointer-address endptr-value)
-                         (uffi:pointer-address str-native))))
-    (uffi:free-foreign-object str-native)
-    (uffi:free-foreign-object endptr)
-    (cond
-     ((zerop chars-parsed)
-      (values nil nil))
-     ((uffi:null-char-p next-char-value)
-      (values value t))
-     (t
-      (values value chars-parsed)))))
+        next-char-value chars-parsed)
 
+    (unwind-protect
+        (if (uffi:null-pointer-p endptr-value)
+            (values value t)
+            (let ((next-char-value (uffi:deref-pointer endptr-value :unsigned-char))
+                  (chars-parsed (- (uffi:pointer-address endptr-value)
+                                   (uffi:pointer-address str-native))))
+              (cond
+                ((zerop chars-parsed)
+                 (values nil nil))
+                ((uffi:null-char-p next-char-value)
+                 (values value t))
+                (t
+                 (values value chars-parsed)))))
+      (progn
+       (uffi:free-foreign-object str-native)
+       (uffi:free-foreign-object endptr)))))
 
+ 
+  
 #+test-uffi
 (progn
   (flet ((print-results (str)

diff --git a/uffi.system b/uffi.system
index d4361bcafccc3715a2ad259d84583de02609a8e0..d1709da82e5591513ad75bdaf43daab1b5de1441 100644 (file)
--- a/uffi.system
+++ b/uffi.system
@@ -1,4 +1,4 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; -*- Mode: ANSI-Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: uffi.system,v 1.5 2002/03/14 21:03:12 kevin Exp $
+;;;; $Id: uffi.system,v 1.6 2002/03/17 17:33:30 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;