From: Kevin M. Rosenberg <kevin@rosenberg.net>
Date: Sun, 17 Mar 2002 17:33:30 +0000 (+0000)
Subject: r1581: *** empty log message ***
X-Git-Tag: v1.6.1~584
X-Git-Url: http://git.kpe.io/?p=uffi.git;a=commitdiff_plain;h=fb93b1923db347f01bdebc7226e5e1eaacacc9f9

r1581: *** empty log message ***
---

diff --git a/ChangeLog b/ChangeLog
index c8e9e1d..cc08f36 100644
--- 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 5cd436d..2d8f503 100644
--- 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 46f91a5..2eb2e1c 100644
--- 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 e077e0a..c45029d 100644
--- 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 8f52638..63aea44 100644
--- 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 48b6e4b..7c5d127 100644
--- 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 1475bd9..3bb97f9 100644
--- 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 62b1a49..4abb951 100644
--- 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 316a7ee..0f28115 100644
--- 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 2555b4c..0048668 100644
--- 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 0d1844e..95fdadf 100644
--- 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 0c33bb2..c8fa0ac 100644
--- 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 e077e0a..c45029d 100644
--- 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 8f52638..63aea44 100644
--- 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 d4361bc..d1709da 100644
--- 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
 ;;;;