r1645: *** empty log message ***

diff --git a/ChangeLog b/ChangeLog
index 0260b37b58a6ca2acde378d7af4bb9963f68c344..9f4b20671ca59400506569b1039786c9e601082e 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -6,6 +6,15 @@
 
        * src/ref.sgml:
        Updated def-array-pointer documentation
+
+       * src/primitives.cl:
+       Made results of def-constant equal those of cl:defconstant
+
+       * src/objects.cl:
+       Made type be evaluated for with-foreign-object and allocate-foreign-object
+       
+       * VERSION:
+       Increase to 0.3.0 to coincide with the release of CLSQL.
        
 21 Mar 2002
        * Fixed problem with NULL foreign-strings with CMUCL

diff --git a/TODO b/TODO
index 389df1dad53dd518f7dadce107972fd9be883d02..05ebcb47926922f689d25166c944a9f9c16f23ed 100644 (file)
--- a/TODO
+++ b/TODO
@@ -1,9 +1,2 @@
-- Cleanup whether types passed to functions are evaluated or not.
-At this point, I think types should always be evaluated. That means
-passing a quote character in front of non-keyword types. So
-:char and '(:array :char) is the way types should be specified.
-This may involve stripping the (quote ...) for some implementations
-like CMUCL which doesn't evaluate the type argument.
-
 - Split implementation-dependent code into separate files in preparation
 for MCL and CormanLisp ports.

diff --git a/VERSION b/VERSION
index 27792457cb5073fab2fc78d02c0052e0c4e43844..69367fd08f3ce302151ebc9779193d517dfa32de 100644 (file)
--- a/VERSION
+++ b/VERSION
@@ -1 +1,2 @@
-0.2.13
+0.3.0
+

diff --git a/doc/Makefile b/doc/Makefile
index b252b024a697fa5336760bc73fab0bbf697bef55..c843fa5747fa572891eabb285c6d36d2690db11e 100644 (file)
--- a/doc/Makefile
+++ b/doc/Makefile
@@ -5,7 +5,7 @@
 #  Programer:    Kevin M. Rosenberg
 #  Date Started: Mar 2002
 #
-#  CVS Id:   $Id: Makefile,v 1.8 2002/03/23 09:09:24 kevin Exp $
+#  CVS Id:   $Id: Makefile,v 1.9 2002/03/23 16:32:39 kevin Exp $
 #
 # This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 #
@@ -53,6 +53,7 @@ PDFFILE=${DOCFILE_BASE}.pdf
 PSFILE=${DOCFILE_BASE}.ps
 DVIFILE=${DOCFILE_BASE}.dvi
 TMPFILES=${DOCFILE_BASE}.aux ${DOCFILE_BASE}.out ${DOCFILE_BASE}.log
+DOCFILES=$(shell echo *.sgml)
 
 all: html pdf ps dvi
 
@@ -63,15 +64,15 @@ CHECK=nsgmls -s -C catalog || exit 1
 check:
        $(CHECK)
 
-html: html/manual.htm
+html: html/book1.htm
 
-html/manual.htm: ${DOCFILE} 
+html/book1.htm: ${DOCFILES} 
        $(CHECK)
-       ( rm -rf html ; mkdir html; cd html ; jade -t sgml -c ../catalog -d ${DSSSL_HTML} ../${DOCFILE}; mv book1.htm manual.htm; cd ..)
+       ( rm -rf html ; mkdir html; cd html ; jade -t sgml -c ../catalog -d ${DSSSL_HTML} ../${DOCFILE}; cd ..)
 
 tex: ${TEXFILE}
 
-${TEXFILE}: ${DOCFILE}
+${TEXFILE}: ${DOCFILES}
        $(CHECK)
        jade -t tex -c catalog -d ${DSSSL_PRINT} ${DOCFILE}
 

diff --git a/doc/ref.sgml b/doc/ref.sgml
index fcb08ebf8af2ca1e2e2e45629fcfe73eee1a7eef..732204a47c7f6de8fd3eb8c686a1592333db5681 100644 (file)
--- a/doc/ref.sgml
+++ b/doc/ref.sgml
@@ -877,7 +877,7 @@ can be freed.
          <varlistentry>
            <term><parameter>type</parameter></term>
            <listitem>
-             <para>A unevaluated type of foreign object to allocate.
+             <para>The type of foreign object to allocate. This parameter is evaluated.
              </para>
            </listitem>
          </varlistentry>
@@ -908,7 +908,7 @@ array of <parameter>type</parameter> that is <parameter>size</parameter> members
        <title>Examples</title>
        <programlisting>
 (def-struct ab (a :int) (b :double))
-(allocate-foreign-object ab)
+(allocate-foreign-object 'ab)
 => #&lt;ptr&gt;
        </programlisting>
       </refsect1>
@@ -973,6 +973,79 @@ array of <parameter>type</parameter> that is <parameter>size</parameter> members
     </refentry>
 
 
+    <refentry id="with-foreign-object">
+      <refnamediv>
+       <refname>with-foreign-object</refname>
+       <refpurpose>Wraps the allocation of a foreign object around a body of code.
+       </refpurpose>
+       <refclass>Macro</refclass>
+      </refnamediv>
+      <refsynopsisdiv>
+       <title>Syntax</title>
+       <synopsis>
+         <function>with-foreign-object</function> <replaceable>(var type) &amp;body body</replaceable> => <returnvalue>form-return</returnvalue>
+       </synopsis>
+      </refsynopsisdiv>
+      <refsect1>
+       <title>Arguments and Values</title>
+       <variablelist>
+         <varlistentry>
+           <term><parameter>var</parameter></term>
+           <listitem>
+             <para>The variable name to bind.
+             </para>
+           </listitem>
+         </varlistentry>
+         <varlistentry>
+           <term><parameter>type</parameter></term>
+           <listitem>
+             <para>The type of foreign object to allocate. This parameter is evaluated.
+             </para>
+           </listitem>
+         </varlistentry>
+         <varlistentry>
+           <term><returnvalue>form-return</returnvalue></term>
+           <listitem>
+             <para>The result of evaluating the <parameter>body</parameter>.
+             </para>
+           </listitem>
+         </varlistentry>
+       </variablelist>
+      </refsect1>
+      <refsect1>
+       <title>Description</title>
+       <para>
+This function wraps the allocation, binding, and destruction of a foreign object.
+On &cmucl; and
+&lw; platforms the object is stack allocated for efficiency. Benchmarks show that &acl; performs
+much better with static allocation.
+       </para>
+      </refsect1>
+      <refsect1>
+       <title>Examples</title>
+       <programlisting>
+(defun gethostname2 ()
+  "Returns the hostname"
+  (uffi:with-foreign-object (name '(:array :unsigned-char 256))
+    (if (zerop (c-gethostname (uffi:char-array-to-pointer name) 256))
+       (uffi:convert-from-foreign-string name)
+       (error "gethostname() failed."))))
+       </programlisting>
+      </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>None.</para>
+      </refsect1>
+    </refentry>
+
     <refentry id="pointer-address">
       <refnamediv>
        <refname>pointer-address</refname>

diff --git a/examples/arrays.cl b/examples/arrays.cl
index e9bbbaaea7cd45a18370f348c928515d4b9b6a61..61f31b2411295101e526fc803343a8248954ca94 100644 (file)
--- a/examples/arrays.cl
+++ b/examples/arrays.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Mar 2002
 ;;;;
-;;;; $Id: arrays.cl,v 1.1 2002/03/21 07:56:45 kevin Exp $
+;;;; $Id: arrays.cl,v 1.2 2002/03/23 16:32:39 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -33,7 +33,7 @@
 
 (defun test-array-2d ()
   "Tests 2d array"
-  (let ((a (uffi:allocate-foreign-object (* :long) +row-length+)))
+  (let ((a (uffi:allocate-foreign-object '(* :long) +row-length+)))
     (dotimes (r +row-length+)
       (declare (fixnum r))
       (setf (uffi:deref-array a '(:array (* :long)) r)

diff --git a/examples/gethostname.cl b/examples/gethostname.cl
index fcec16e66fca67142cf7dc6abe89ed0432021cfe..409afd979aebebcd43c5ce54db76bb124c446667 100644 (file)
--- a/examples/gethostname.cl
+++ b/examples/gethostname.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: gethostname.cl,v 1.8 2002/03/22 20:51:08 kevin Exp $
+;;;; $Id: gethostname.cl,v 1.9 2002/03/23 16:32:39 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -38,7 +38,7 @@
 
 (defun gethostname2 ()
   "Returns the hostname"
-  (uffi:with-foreign-object (name (:array :unsigned-char 256))
+  (uffi:with-foreign-object (name '(:array :unsigned-char 256))
     (if (zerop (c-gethostname (uffi:char-array-to-pointer name) 256))
        (uffi:convert-from-foreign-string name)
        (error "gethostname() failed."))))

diff --git a/examples/gettime.cl b/examples/gettime.cl
index 12012565ffc9f5d827ad09da169021d934c9edbe..69b2f07969dae55d025884f8fd1ae1f0b6af49bf 100644 (file)
--- a/examples/gettime.cl
+++ b/examples/gettime.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: gettime.cl,v 1.6 2002/03/14 21:03:12 kevin Exp $
+;;;; $Id: gettime.cl,v 1.7 2002/03/23 16:32:39 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -44,8 +44,8 @@
 
 (defun gettime ()
    "Returns the local time"
-   (let* ((time (uffi:allocate-foreign-object time-t)))
-     (declare (type time-t time))
+   (uffi:with-foreign-object (time 'time-t)
+;;     (declare (type time-t time))
      (c-time time)
      (let ((tm-ptr (the tm-pointer (c-localtime time))))
        (declare (type tm-pointer tm-ptr))
@@ -57,9 +57,7 @@
                                  (uffi:get-slot-value tm-ptr 'tm 'min)
                                  (uffi:get-slot-value tm-ptr 'tm 'sec)
                                  )))
-        (uffi:free-foreign-object time)
-        time-string))
-     ))
+        time-string))))
 
 
 

diff --git a/examples/strtol.cl b/examples/strtol.cl
index eefee46e261175b7654c506ce7fc9004adb6a519..a115b2a8019e856058a0b21edbaf14d0a247574f 100644 (file)
--- a/examples/strtol.cl
+++ b/examples/strtol.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: strtol.cl,v 1.11 2002/03/20 04:56:52 kevin Exp $
+;;;; $Id: strtol.cl,v 1.12 2002/03/23 16:32:39 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -36,7 +36,7 @@ Condition flag is T if all of string parses as a long, NIL if
 their was no string at all, or an integer indicating position in string
 of first non-valid character"
   (let* ((str-native (uffi:convert-to-foreign-string str))
-        (endptr (uffi:allocate-foreign-object char-ptr))
+        (endptr (uffi:allocate-foreign-object 'char-ptr))
         (value (c-strtol str-native endptr base))
         (endptr-value (uffi:deref-pointer endptr 'char-ptr)))
 

diff --git a/examples/union.cl b/examples/union.cl
index b876699b6f1fd7ae5fc312e47a16c049f9351c25..d0d32812ab4661592af50cd81ea940a4ce6d3361 100644 (file)
--- a/examples/union.cl
+++ b/examples/union.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Mar 2002
 ;;;;
-;;;; $Id: union.cl,v 1.2 2002/03/21 08:30:10 kevin Exp $
+;;;; $Id: union.cl,v 1.3 2002/03/23 16:32:39 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -26,18 +26,18 @@
   (df :double))
 
 (defun test-union-1 ()
-  (let ((u (uffi:allocate-foreign-object tunion1)))
+  (let ((u (uffi:allocate-foreign-object 'tunion1)))
     (setf (uffi:get-slot-value u 'tunion1 'uint) 
       (+ (char-code #\A) 
         (* 256 (char-code #\B))
         (* 65536 (char-code #\C))
         (* 16777216 255)))
-    (format t "~&Should be #\A: ~S" 
+    (format *standard-output* "~&Should be #\A: ~S" 
            (uffi:ensure-char-character 
             (uffi:get-slot-value u 'tunion1 'char)))
-    (format t "~&Should be negative number: ~D" 
+    (format *standard-output* "~&Should be negative number: ~D" 
            (uffi:get-slot-value u 'tunion1 'int))
-    (format t "~&Should be positive number: ~D"
+    (format *standard-output* "~&Should be positive number: ~D"
            (uffi:get-slot-value u 'tunion1 'uint))
     (uffi:free-foreign-object u))
   (values))

diff --git a/src/objects.cl b/src/objects.cl
index b510b35bcd47f9627f0b1d46445c389d9bb85797..014fe9d2fae243f97d4d2b63c94a29ea583eba0c 100644 (file)
--- a/src/objects.cl
+++ b/src/objects.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: objects.cl,v 1.14 2002/03/22 20:51:08 kevin Exp $
+;;;; $Id: objects.cl,v 1.15 2002/03/23 16:32:39 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -21,22 +21,22 @@
 
 (defmacro allocate-foreign-object (type &optional (size :unspecified))
   "Allocates an instance of TYPE. If size is specified, then allocate
-an array of TYPE with size SIZE."
+an array of TYPE with size SIZE. The TYPE parameter is evaluated."
   (if (eq size :unspecified)
       (progn
        #+cmu
-       `(alien:make-alien ,(convert-from-uffi-type type :allocation))
+       `(alien:make-alien ,(convert-from-uffi-type (eval type) :allocation))
        #+lispworks
-       `(fli:allocate-foreign-object :type ',(convert-from-uffi-type type :allocate))
+       `(fli:allocate-foreign-object :type ,(convert-from-uffi-type type :allocate))
        #+allegro
-       `(ff:allocate-fobject ',(convert-from-uffi-type type :allocate) :c))
+       `(ff:allocate-fobject ,(convert-from-uffi-type type :allocate) :c))
       (progn
        #+cmu
-       `(alien:make-alien ,(convert-from-uffi-type type :allocation) ,size)
+       `(alien:make-alien ,(convert-from-uffi-type (eval type) :allocation) ,size)
        #+lispworks
-       `(fli:allocate-foreign-object :type ',(convert-from-uffi-type type :allocate) :nelems ,size)
+       `(fli:allocate-foreign-object :type ,(convert-from-uffi-type type :allocate) :nelems ,size)
        #+allegro
-       `(ff:allocate-fobject '(:array ,(convert-from-uffi-type type :allocate) ,(eval size)) :c)
+       `(ff:allocate-fobject '(:array ,(convert-from-uffi-type (eval type) :allocate) ,(eval size)) :c)
       )
   ))
 
@@ -107,6 +107,7 @@ an array of TYPE with size SIZE."
   obj
   )
 
+;; TYPE is evaluated.
 (defmacro with-foreign-object ((var type) &rest body)
   #-(or cmu lispworks) ; default version
   `(let ((,var (allocate-foreign-object ,type)))
@@ -115,12 +116,12 @@ an array of TYPE with size SIZE."
       (free-foreign-object ,var)))
   #+cmu
   (let ((obj (gensym)))
-    `(alien:with-alien ((,obj ,(convert-from-uffi-type type :allocate)))
+    `(alien:with-alien ((,obj ,(convert-from-uffi-type (eval type) :allocate)))
        (let ((,var (alien:addr ,obj)))
         ,@body)))
   #+lispworks
   `(fli:with-dynamic-foreign-objects ((,var ,(convert-from-uffi-type
-                                             type :allocate)))
+                                             (eval type) :allocate)))
     ,@body)
   )
 

diff --git a/src/primitives.cl b/src/primitives.cl
index 8a29b21318087606e6956b928cd377776206114a..d41c75dc8eb40219aeb896840af970527a7c3f0e 100644 (file)
--- a/src/primitives.cl
+++ b/src/primitives.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: primitives.cl,v 1.13 2002/03/23 09:32:43 kevin Exp $
+;;;; $Id: primitives.cl,v 1.14 2002/03/23 16:32:39 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -23,7 +23,8 @@
   "Macro to define a constant and to export it"
   `(eval-when (:compile-toplevel :load-toplevel :execute)
      (defconstant ,name ,value)
-     ,(if export (list 'export `(quote ,name)) (values))))
+     ,(when export (list 'export `(quote ,name)))
+    ',name))
 
 (defmacro def-type (name type)
   "Generates a (deftype) statement for CL. Currently, only CMUCL

diff --git a/tests/arrays.cl b/tests/arrays.cl
index e9bbbaaea7cd45a18370f348c928515d4b9b6a61..61f31b2411295101e526fc803343a8248954ca94 100644 (file)
--- a/tests/arrays.cl
+++ b/tests/arrays.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Mar 2002
 ;;;;
-;;;; $Id: arrays.cl,v 1.1 2002/03/21 07:56:45 kevin Exp $
+;;;; $Id: arrays.cl,v 1.2 2002/03/23 16:32:39 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -33,7 +33,7 @@
 
 (defun test-array-2d ()
   "Tests 2d array"
-  (let ((a (uffi:allocate-foreign-object (* :long) +row-length+)))
+  (let ((a (uffi:allocate-foreign-object '(* :long) +row-length+)))
     (dotimes (r +row-length+)
       (declare (fixnum r))
       (setf (uffi:deref-array a '(:array (* :long)) r)

diff --git a/tests/gethostname.cl b/tests/gethostname.cl
index fcec16e66fca67142cf7dc6abe89ed0432021cfe..409afd979aebebcd43c5ce54db76bb124c446667 100644 (file)
--- a/tests/gethostname.cl
+++ b/tests/gethostname.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: gethostname.cl,v 1.8 2002/03/22 20:51:08 kevin Exp $
+;;;; $Id: gethostname.cl,v 1.9 2002/03/23 16:32:39 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -38,7 +38,7 @@
 
 (defun gethostname2 ()
   "Returns the hostname"
-  (uffi:with-foreign-object (name (:array :unsigned-char 256))
+  (uffi:with-foreign-object (name '(:array :unsigned-char 256))
     (if (zerop (c-gethostname (uffi:char-array-to-pointer name) 256))
        (uffi:convert-from-foreign-string name)
        (error "gethostname() failed."))))

diff --git a/tests/gettime.cl b/tests/gettime.cl
index 12012565ffc9f5d827ad09da169021d934c9edbe..69b2f07969dae55d025884f8fd1ae1f0b6af49bf 100644 (file)
--- a/tests/gettime.cl
+++ b/tests/gettime.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: gettime.cl,v 1.6 2002/03/14 21:03:12 kevin Exp $
+;;;; $Id: gettime.cl,v 1.7 2002/03/23 16:32:39 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -44,8 +44,8 @@
 
 (defun gettime ()
    "Returns the local time"
-   (let* ((time (uffi:allocate-foreign-object time-t)))
-     (declare (type time-t time))
+   (uffi:with-foreign-object (time 'time-t)
+;;     (declare (type time-t time))
      (c-time time)
      (let ((tm-ptr (the tm-pointer (c-localtime time))))
        (declare (type tm-pointer tm-ptr))
@@ -57,9 +57,7 @@
                                  (uffi:get-slot-value tm-ptr 'tm 'min)
                                  (uffi:get-slot-value tm-ptr 'tm 'sec)
                                  )))
-        (uffi:free-foreign-object time)
-        time-string))
-     ))
+        time-string))))
 
 
 

diff --git a/tests/strtol.cl b/tests/strtol.cl
index eefee46e261175b7654c506ce7fc9004adb6a519..a115b2a8019e856058a0b21edbaf14d0a247574f 100644 (file)
--- a/tests/strtol.cl
+++ b/tests/strtol.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: strtol.cl,v 1.11 2002/03/20 04:56:52 kevin Exp $
+;;;; $Id: strtol.cl,v 1.12 2002/03/23 16:32:39 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -36,7 +36,7 @@ Condition flag is T if all of string parses as a long, NIL if
 their was no string at all, or an integer indicating position in string
 of first non-valid character"
   (let* ((str-native (uffi:convert-to-foreign-string str))
-        (endptr (uffi:allocate-foreign-object char-ptr))
+        (endptr (uffi:allocate-foreign-object 'char-ptr))
         (value (c-strtol str-native endptr base))
         (endptr-value (uffi:deref-pointer endptr 'char-ptr)))
 

diff --git a/tests/union.cl b/tests/union.cl
index b876699b6f1fd7ae5fc312e47a16c049f9351c25..d0d32812ab4661592af50cd81ea940a4ce6d3361 100644 (file)
--- a/tests/union.cl
+++ b/tests/union.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Mar 2002
 ;;;;
-;;;; $Id: union.cl,v 1.2 2002/03/21 08:30:10 kevin Exp $
+;;;; $Id: union.cl,v 1.3 2002/03/23 16:32:39 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -26,18 +26,18 @@
   (df :double))
 
 (defun test-union-1 ()
-  (let ((u (uffi:allocate-foreign-object tunion1)))
+  (let ((u (uffi:allocate-foreign-object 'tunion1)))
     (setf (uffi:get-slot-value u 'tunion1 'uint) 
       (+ (char-code #\A) 
         (* 256 (char-code #\B))
         (* 65536 (char-code #\C))
         (* 16777216 255)))
-    (format t "~&Should be #\A: ~S" 
+    (format *standard-output* "~&Should be #\A: ~S" 
            (uffi:ensure-char-character 
             (uffi:get-slot-value u 'tunion1 'char)))
-    (format t "~&Should be negative number: ~D" 
+    (format *standard-output* "~&Should be negative number: ~D" 
            (uffi:get-slot-value u 'tunion1 'int))
-    (format t "~&Should be positive number: ~D"
+    (format *standard-output* "~&Should be positive number: ~D"
            (uffi:get-slot-value u 'tunion1 'uint))
     (uffi:free-foreign-object u))
   (values))