NEWS im ARCHIV

last updated %%DATE%% · ~A

+$(address)
+$(postcode)
+$(country)
+
~A
"
+                                 ""))))
+                 (cond (len
+                         (setq line-processor #'process-line-inside-pre)
+                         (write-string "" output)
+                         (push (subseq line (+ len +indent+)) piece-of-code)
+                         (push (string #\Newline) piece-of-code))
+                       (t (write-line line output))))))
+          (setf line-processor #'process-regular-line)
+          (with-each-stream-line (line input)
+            (funcall line-processor line)))))))
+
+(defun process-dir (dir)
+  (dolist (html-file (directory dir))
+    (let* ((name (namestring html-file))
+           (temp-name (strcat name ".temp")))
+      (process-file name temp-name)
+      (system "mv ~A ~A" temp-name name))))
+
+;; (go "/tmp/doc/manual/html_node/*.html")
+
+#+clisp
+(progn
+  (assert (first ext:*args*))
+  (process-dir (first ext:*args*)))
+
+#+sbcl
+(progn
+  (assert (second sb-ext:*posix-argv*))
+  (process-dir (second sb-ext:*posix-argv*))
+  (sb-ext:quit))

Added: branches/xml-class-rework/thirdparty/cffi/doc/gendocs.sh
===================================================================

--- branches/xml-class-rework/thirdparty/cffi/doc/gendocs.sh	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/doc/gendocs.sh	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,310 @@
+#!/bin/sh
+# gendocs.sh -- generate a GNU manual in many formats.  This script is
+#   mentioned in maintain.texi.  See the help message below for usage details.
+# $Id: gendocs.sh,v 1.16 2005/05/15 00:00:08 karl Exp $
+# 
+# Copyright (C) 2003, 2004, 2005 Free Software Foundation, Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, you can either send email to this
+# program's maintainer or write to: The Free Software Foundation,
+# Inc.; 51 Franklin Street, Fifth Floor; Boston, MA 02110-1301, USA.
+#
+# Original author: Mohit Agarwal.
+# Send bug reports and any other correspondence to bug-texinfo at gnu.org.
+
+prog="`basename \"$0\"`"
+srcdir=`pwd`
+
+scripturl="http://common-lisp.net/project/cffi/darcs/cffi/doc/gendocs.sh"
+templateurl="http://savannah.gnu.org/cgi-bin/viewcvs/texinfo/texinfo/util/gendocs_template"
+
+: ${MAKEINFO="makeinfo"}
+: ${TEXI2DVI="texi2dvi -t @finalout"}
+: ${DVIPS="dvips"}
+: ${DOCBOOK2TXT="docbook2txt"}
+: ${DOCBOOK2HTML="docbook2html"}
+: ${DOCBOOK2PDF="docbook2pdf"}
+: ${DOCBOOK2PS="docbook2ps"}
+: ${GENDOCS_TEMPLATE_DIR="."}
+unset CDPATH
+
+rcs_revision='$Revision: 1.16 $'
+rcs_version=`set - $rcs_revision; echo $2`
+program=`echo $0 | sed -e 's!.*/!!'`
+version="gendocs.sh $rcs_version
+
+Copyright (C) 2005 Free Software Foundation, Inc.
+There is NO warranty.  You may redistribute this software
+under the terms of the GNU General Public License.
+For more information about these matters, see the files named COPYING."
+
+usage="Usage: $prog [OPTION]... PACKAGE MANUAL-TITLE
+
+Generate various output formats from PACKAGE.texinfo (or .texi or .txi) source.
+See the GNU Maintainers document for a more extensive discussion:
+  http://www.gnu.org/prep/maintain_toc.html
+
+Options:
+  -o OUTDIR   write files into OUTDIR, instead of manual/.
+  --docbook   convert to DocBook too (xml, txt, html, pdf and ps).
+  --html ARG  pass indicated ARG to makeinfo for HTML targets.
+  --help      display this help and exit successfully.
+  --version   display version information and exit successfully.
+
+Simple example: $prog emacs \"GNU Emacs Manual\"
+
+Typical sequence:
+  cd YOURPACKAGESOURCE/doc
+  wget \"$scripturl\"
+  wget \"$templateurl\"
+  $prog YOURMANUAL \"GNU YOURMANUAL - One-line description\"
+
+Output will be in a new subdirectory \"manual\" (by default, use -o OUTDIR
+to override).  Move all the new files into your web CVS tree, as
+explained in the Web Pages node of maintain.texi.
+
+MANUAL-TITLE is included as part of the HTML  of the overall
+manual/index.html file.  It should include the name of the package being
+documented.  manual/index.html is created by substitution from the file
+$GENDOCS_TEMPLATE_DIR/gendocs_template.  (Feel free to modify the
+generic template for your own purposes.)
+
+If you have several manuals, you'll need to run this script several
+times with different YOURMANUAL values, specifying a different output
+directory with -o each time.  Then write (by hand) an overall index.html
+with links to them all.
+
+You can set the environment variables MAKEINFO, TEXI2DVI, and DVIPS to
+control the programs that get executed, and GENDOCS_TEMPLATE_DIR to
+control where the gendocs_template file is looked for.
+
+Email bug reports or enhancement requests to bug-texinfo at gnu.org.
+"
+
+calcsize()
+{
+  size="`ls -ksl $1 | awk '{print $1}'`"
+  echo $size
+}
+
+outdir=manual
+html=
+PACKAGE=
+MANUAL_TITLE=
+
+while test $# -gt 0; do
+  case $1 in
+    --help) echo "$usage"; exit 0;;
+    --version) echo "$version"; exit 0;;
+    -o) shift; outdir=$1;;
+    --docbook) docbook=yes;;
+    --html) shift; html=$1;;
+    -*)
+      echo "$0: Unknown or ambiguous option \`$1'." >&2
+      echo "$0: Try \`--help' for more information." >&2
+      exit 1;;
+    *)
+      if test -z "$PACKAGE"; then
+        PACKAGE=$1
+      elif test -z "$MANUAL_TITLE"; then
+        MANUAL_TITLE=$1
+      else
+        echo "$0: extra non-option argument \`$1'." >&2
+        exit 1
+      fi;;
+  esac
+  shift
+done
+
+if test -s $srcdir/$PACKAGE.texinfo; then
+  srcfile=$srcdir/$PACKAGE.texinfo
+elif test -s $srcdir/$PACKAGE.texi; then
+  srcfile=$srcdir/$PACKAGE.texi
+elif test -s $srcdir/$PACKAGE.txi; then
+  srcfile=$srcdir/$PACKAGE.txi
+else
+  echo "$0: cannot find .texinfo or .texi or .txi for $PACKAGE in $srcdir." >&2
+  exit 1
+fi
+
+if test ! -r $GENDOCS_TEMPLATE_DIR/gendocs_template; then
+  echo "$0: cannot read $GENDOCS_TEMPLATE_DIR/gendocs_template." >&2
+  echo "$0: it is available from $templateurl." >&2
+  exit 1
+fi
+
+echo Generating output formats for $srcfile
+
+cmd="${MAKEINFO} -o $PACKAGE.info $srcfile"
+echo "Generating info files... ($cmd)"
+eval $cmd
+mkdir -p $outdir/
+tar czf $outdir/$PACKAGE.info.tar.gz $PACKAGE.info*
+info_tgz_size="`calcsize $outdir/$PACKAGE.info.tar.gz`"
+# do not mv the info files, there's no point in having them available
+# separately on the web.
+
+cmd="${TEXI2DVI} $srcfile"
+echo "Generating dvi ... ($cmd)"
+eval $cmd
+
+# now, before we compress dvi:
+echo Generating postscript...
+${DVIPS} $PACKAGE -o
+gzip -f -9 $PACKAGE.ps
+ps_gz_size="`calcsize $PACKAGE.ps.gz`"
+mv $PACKAGE.ps.gz $outdir/
+
+# compress/finish dvi:
+gzip -f -9 $PACKAGE.dvi
+dvi_gz_size="`calcsize $PACKAGE.dvi.gz`"
+mv $PACKAGE.dvi.gz $outdir/
+
+cmd="${TEXI2DVI} --pdf $srcfile"
+echo "Generating pdf ... ($cmd)"
+eval $cmd
+pdf_size="`calcsize $PACKAGE.pdf`"
+mv $PACKAGE.pdf $outdir/
+
+cmd="${MAKEINFO} -o $PACKAGE.txt --no-split --no-headers $srcfile"
+echo "Generating ASCII... ($cmd)"
+eval $cmd
+ascii_size="`calcsize $PACKAGE.txt`"
+gzip -f -9 -c $PACKAGE.txt >$outdir/$PACKAGE.txt.gz
+ascii_gz_size="`calcsize $outdir/$PACKAGE.txt.gz`"
+mv $PACKAGE.txt $outdir/
+
+# Print a SED expression that will translate references to MANUAL to
+# the proper page on gnu.org.  This is a horrible shell hack done
+# because \| in sed regexps is a GNU extension.
+monognuorg () {
+    case "$1" in
+	libtool) echo "s!$1.html!http://www.gnu.org/software/$1/manual.html!" ;;
+	*) echo "s!$1.html!http://www.gnu.org/software/$1/manual/html_mono/$1.html!" ;;
+    esac
+}
+polygnuorg () {
+    case "$1" in
+	libtool) echo 's!\.\./'"$1/.*\.html!http://www.gnu.org/software/$1/manual.html!" ;;
+	*) echo 's!\.\./'"$1!http://www.gnu.org/software/$1/manual/html_node!" ;;
+    esac
+}
+
+cmd="${MAKEINFO} --no-split --html -o $PACKAGE.html $html $srcfile"
+echo "Generating monolithic html... ($cmd)"
+rm -rf $PACKAGE.html  # in case a directory is left over
+eval $cmd
+sbcl --load colorize-lisp-examples.lisp $PACKAGE.html
+#fix libc/libtool xrefs
+sed -e `monognuorg libc` -e `monognuorg libtool` $PACKAGE.html >$outdir/$PACKAGE.html
+rm $PACKAGE.html
+html_mono_size="`calcsize $outdir/$PACKAGE.html`"
+gzip -f -9 -c $outdir/$PACKAGE.html >$outdir/$PACKAGE.html.gz
+html_mono_gz_size="`calcsize $outdir/$PACKAGE.html.gz`"
+
+cmd="${MAKEINFO} --html -o $PACKAGE.html $html $srcfile"
+echo "Generating html by node... ($cmd)"
+eval $cmd
+split_html_dir=$PACKAGE.html
+sbcl --load colorize-lisp-examples.lisp "${split_html_dir}/*.html"
+(
+  cd ${split_html_dir} || exit 1
+  #fix libc xrefs
+  for broken_file in *.html; do
+      sed -e `polygnuorg libc` -e `polygnuorg libtool` "$broken_file" > "$broken_file".temp
+      mv -f "$broken_file".temp "$broken_file"
+  done
+  tar -czf ../$outdir/${PACKAGE}.html_node.tar.gz -- *.html
+)
+html_node_tgz_size="`calcsize $outdir/${PACKAGE}.html_node.tar.gz`"
+rm -f $outdir/html_node/*.html
+mkdir -p $outdir/html_node/
+mv ${split_html_dir}/*.html $outdir/html_node/
+rmdir ${split_html_dir}
+
+echo Making .tar.gz for sources...
+srcfiles=`ls *.texinfo *.texi *.txi *.eps 2>/dev/null`
+tar cvzfh $outdir/$PACKAGE.texi.tar.gz $srcfiles
+texi_tgz_size="`calcsize $outdir/$PACKAGE.texi.tar.gz`"
+
+if test -n "$docbook"; then
+  cmd="${MAKEINFO} -o - --docbook $srcfile > ${srcdir}/$PACKAGE-db.xml"
+  echo "Generating docbook XML... $(cmd)"
+  eval $cmd
+  docbook_xml_size="`calcsize $PACKAGE-db.xml`"
+  gzip -f -9 -c $PACKAGE-db.xml >$outdir/$PACKAGE-db.xml.gz
+  docbook_xml_gz_size="`calcsize $outdir/$PACKAGE-db.xml.gz`"
+  mv $PACKAGE-db.xml $outdir/
+
+  cmd="${DOCBOOK2HTML} -o $split_html_db_dir ${outdir}/$PACKAGE-db.xml"
+  echo "Generating docbook HTML... ($cmd)"
+  eval $cmd
+  split_html_db_dir=html_node_db
+  (
+    cd ${split_html_db_dir} || exit 1
+    tar -czf ../$outdir/${PACKAGE}.html_node_db.tar.gz -- *.html
+  )
+  html_node_db_tgz_size="`calcsize $outdir/${PACKAGE}.html_node_db.tar.gz`"
+  rm -f $outdir/html_node_db/*.html
+  mkdir -p $outdir/html_node_db
+  mv ${split_html_db_dir}/*.html $outdir/html_node_db/
+  rmdir ${split_html_db_dir}
+
+  cmd="${DOCBOOK2TXT} ${outdir}/$PACKAGE-db.xml"
+  echo "Generating docbook ASCII... ($cmd)"
+  eval $cmd
+  docbook_ascii_size="`calcsize $PACKAGE-db.txt`"
+  mv $PACKAGE-db.txt $outdir/
+
+  cmd="${DOCBOOK2PS} ${outdir}/$PACKAGE-db.xml"
+  echo "Generating docbook PS... $(cmd)"
+  eval $cmd
+  gzip -f -9 -c $PACKAGE-db.ps >$outdir/$PACKAGE-db.ps.gz
+  docbook_ps_gz_size="`calcsize $outdir/$PACKAGE-db.ps.gz`"
+  mv $PACKAGE-db.ps $outdir/
+
+  cmd="${DOCBOOK2PDF} ${outdir}/$PACKAGE-db.xml"
+  echo "Generating docbook PDF... ($cmd)"
+  eval $cmd
+  docbook_pdf_size="`calcsize $PACKAGE-db.pdf`"
+  mv $PACKAGE-db.pdf $outdir/
+fi
+
+echo Writing index file...
+curdate="`date '+%B %d, %Y'`"
+sed \
+   -e "s!%%TITLE%%!$MANUAL_TITLE!g" \
+   -e "s!%%DATE%%!$curdate!g" \
+   -e "s!%%PACKAGE%%!$PACKAGE!g" \
+   -e "s!%%HTML_MONO_SIZE%%!$html_mono_size!g" \
+   -e "s!%%HTML_MONO_GZ_SIZE%%!$html_mono_gz_size!g" \
+   -e "s!%%HTML_NODE_TGZ_SIZE%%!$html_node_tgz_size!g" \
+   -e "s!%%INFO_TGZ_SIZE%%!$info_tgz_size!g" \
+   -e "s!%%DVI_GZ_SIZE%%!$dvi_gz_size!g" \
+   -e "s!%%PDF_SIZE%%!$pdf_size!g" \
+   -e "s!%%PS_GZ_SIZE%%!$ps_gz_size!g" \
+   -e "s!%%ASCII_SIZE%%!$ascii_size!g" \
+   -e "s!%%ASCII_GZ_SIZE%%!$ascii_gz_size!g" \
+   -e "s!%%TEXI_TGZ_SIZE%%!$texi_tgz_size!g" \
+   -e "s!%%DOCBOOK_HTML_NODE_TGZ_SIZE%%!$html_node_db_tgz_size!g" \
+   -e "s!%%DOCBOOK_ASCII_SIZE%%!$docbook_ascii_size!g" \
+   -e "s!%%DOCBOOK_PS_GZ_SIZE%%!$docbook_ps_gz_size!g" \
+   -e "s!%%DOCBOOK_PDF_SIZE%%!$docbook_pdf_size!g" \
+   -e "s!%%DOCBOOK_XML_SIZE%%!$docbook_xml_size!g" \
+   -e "s!%%DOCBOOK_XML_GZ_SIZE%%!$docbook_xml_gz_size!g" \
+   -e "s,%%SCRIPTURL%%,$scripturl,g" \
+   -e "s!%%SCRIPTNAME%%!$prog!g" \
+$GENDOCS_TEMPLATE_DIR/gendocs_template >$outdir/index.html
+
+echo "Done!  See $outdir/ subdirectory for new files."


Property changes on: branches/xml-class-rework/thirdparty/cffi/doc/gendocs.sh
___________________________________________________________________
Name: svn:executable
   + *
Name: svn:eol-style
   + native

Added: branches/xml-class-rework/thirdparty/cffi/doc/gendocs_template
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/doc/gendocs_template	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/doc/gendocs_template	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,259 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<!-- $Id: gendocs_template,v 1.7 2005/05/15 00:00:08 karl Exp $ -->
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
+
+<!--
+
+ This template was adapted from Texinfo:
+ http://savannah.gnu.org/cgi-bin/viewcvs/texinfo/texinfo/util/gendocs_template
+
+-->
+
+
+<head>
+<title>%%TITLE%%
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+%%TITLE%%
+
+
+last updated %%DATE%%
+
+
+
+
+
+This document  is available in the following formats:
+
+
+  HTML 
+      (%%HTML_MONO_SIZE%%K characters) - entirely on one web page.
+  HTML - with one web page per
+      node.
+  HTML compressed
+      (%%HTML_MONO_GZ_SIZE%%K gzipped characters) - entirely on 
+      one web page.
+  HTML compressed
+      (%%HTML_NODE_TGZ_SIZE%%K gzipped tar file) -
+      with one web page per node.
+  Info document
+      (%%INFO_TGZ_SIZE%%K characters gzipped tar file).
+  ASCII text
+      (%%ASCII_SIZE%%K characters).
+  ASCII text compressed
+      (%%ASCII_GZ_SIZE%%K gzipped characters).
+  TeX dvi file
+      (%%DVI_GZ_SIZE%%K characters gzipped).
+  PostScript file
+      (%%PS_GZ_SIZE%%K characters gzipped).
+  PDF file
+      (%%PDF_SIZE%%K characters).
+  Texinfo source
+      (%%TEXI_TGZ_SIZE%%K characters gzipped tar file)
+
+
+(This page was generated by the %%SCRIPTNAME%%
+script.)
+
+
+
+Return to CFFI's home page.
+
+
+
+
+
+Copyright (C) 2005 James Bielman  <jamesjb at jamesjb.com>

+Copyright (C) 2005 Luís Oliveira  <loliveira at common-lisp.net>
+
+
+
+
+Updated: %%DATE%%
+
+
+
+
+
+
+
+

Added: branches/xml-class-rework/thirdparty/cffi/doc/mem-vector.txt
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/doc/mem-vector.txt	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/doc/mem-vector.txt	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,75 @@
+
+# Block Memory Operations
+
+Function: mem-fill ptr type count value &optional (offset 0)
+
+Fill COUNT objects of TYPE, starting at PTR plus offset, with VALUE.
+
+;; Equivalent to (but possibly more efficient than):
+(loop for i below count
+      for off from offset by (%foreign-type-size type)
+      do (setf (%mem-ref ptr type off) value))
+
+Function: mem-read-vector vector ptr type count &optional (offset 0)
+
+Copy COUNT objects of TYPE from foreign memory at PTR plus OFFSET into
+VECTOR.  If VECTOR is not large enough to contain COUNT objects, it
+will copy as many objects as necessary to fill the vector.  The
+results are undefined if the foreign memory block is not large enough
+to supply the data to copy.
+
+TYPE must be a built-in foreign type (integer, float, double, or
+pointer).
+
+Returns the number of objects copied.
+
+;; Equivalent to (but possibly more efficient than):
+(loop for i below (min count (length vector))
+      for off from offset by (%foreign-type-size type)
+      do (setf (aref vector i) (%mem-ref ptr type off))
+      finally (return i))
+
+
+Function: mem-read-c-string string ptr &optional (offset 0)
+
+Copy a null-terminated C string from PTR plus OFFSET into STRING, a
+Lisp string.  If STRING is not large enough to contain the data at PTR
+it will be truncated.
+
+Returns the number of characters copied into STRING.
+
+;; Equivalent to (but possibly more efficient than):
+(loop for i below (length string)
+      for off from offset
+      for char = (%mem-ref ptr :char off)
+      until (zerop char)
+      do (setf (char string i) char)
+      finally (return i))
+
+Function: mem-write-vector vector ptr type &optional
+                           (count (length vector)) (offset 0)
+
+Copy COUNT objects from VECTOR into objects of TYPE in foreign memory,
+starting at PTR plus OFFSET.  The results are undefined if PTR does
+not point to a memory block large enough to hold the data copied.
+
+TYPE must be a built-in type (integer, float, double, or pointer).
+
+Returns the number of objects copied from VECTOR to PTR.
+
+;; Equivalent to (but possibly more efficient than):
+(loop for i below count
+      for off from offset by (%foreign-type-size type)
+      do (setf (%mem-ref ptr type off) (aref vector i))
+      finally (return i))
+
+
+Function: mem-write-c-string string ptr &optional (offset 0)
+
+Copy the characters from a Lisp STRING to PTR plus OFFSET, adding a
+final null terminator at the end.  The results are undefined if the
+memory at PTR is not large enough to accomodate the data.
+
+This interface is currently equivalent to MEM-WRITE-VECTOR with a TYPE
+of :CHAR, but will be useful when proper support for Unicode strings
+is implemented.


Property changes on: branches/xml-class-rework/thirdparty/cffi/doc/mem-vector.txt
___________________________________________________________________
Name: svn:eol-style
   + native

Added: branches/xml-class-rework/thirdparty/cffi/doc/shareable-vectors.txt
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/doc/shareable-vectors.txt	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/doc/shareable-vectors.txt	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,44 @@
+
+# Shareable Byte Vectors
+
+Function: make-shareable-byte-vector size
+
+Create a vector of element type (UNSIGNED-BYTE 8) suitable for passing
+to WITH-POINTER-TO-VECTOR-DATA.
+
+;; Minimal implementation:
+(defun make-shareable-byte-vector (size)
+  (make-array size :element-type '(unsigned-byte 8)))
+
+
+Macro: with-pointer-to-vector-data (ptr-var vector) &body body
+
+Bind PTR-VAR to a pointer to the data contained in a shareable byte
+vector.
+
+VECTOR must be a shareable vector created by MAKE-SHAREABLE-BYTE-VECTOR.
+
+PTR-VAR may point directly into the Lisp vector data, or it may point
+to a temporary block of foreign memory which will be copied to and
+from VECTOR.
+
+Both the pointer object in PTR-VAR and the memory it points to have
+dynamic extent.  The results are undefined if foreign code attempts to
+access this memory outside this dynamic contour.
+
+The implementation must guarantee the memory pointed to by PTR-VAR
+will not be moved during the dynamic contour of this operator, either
+by creating the vector in a static area or temporarily disabling the
+garbage collector.
+
+;; Minimal (copying) implementation:
+(defmacro with-pointer-to-vector-data ((ptr-var vector) &body body)
+  (let ((vector-var (gensym))
+        (size-var (gensym)))
+    `(let* ((,vector-var ,vector)
+            (,size-var (length ,vector-var)))
+       (with-foreign-ptr (,ptr-var ,size-var)
+         (mem-write-vector ,vector-var ,ptr :uint8)
+         (prog1
+             (progn , at body)
+           (mem-read-vector ,vector-var ,ptr-var :uint8 ,size-var))))))


Property changes on: branches/xml-class-rework/thirdparty/cffi/doc/shareable-vectors.txt
___________________________________________________________________
Name: svn:eol-style
   + native

Added: branches/xml-class-rework/thirdparty/cffi/doc/style.css
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/doc/style.css	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/doc/style.css	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,48 @@
+body {font-family: century schoolbook, serif;
+      line-height: 1.3;
+      padding-left: 5em; padding-right: 1em;
+      padding-bottom: 1em; max-width: 60em;}
+table {border-collapse: collapse}
+span.roman { font-family: century schoolbook, serif; font-weight: normal; }
+h1, h2, h3, h4, h5, h6 {font-family:  Helvetica, sans-serif}
+/*h4 {padding-top: 0.75em;}*/
+dfn {font-family: inherit; font-variant: italic; font-weight: bolder }
+kbd {font-family: monospace; text-decoration: underline}
+/*var {font-family: Helvetica, sans-serif; font-variant: slanted}*/
+var {font-variant: slanted;}
+td  {padding-right: 1em; padding-left: 1em}
+sub {font-size: smaller}
+.node {padding: 0; margin: 0}
+
+.lisp { font-family: monospace;
+        background-color: #F4F4F4; border: 1px solid #AAA;
+        padding-top: 0.5em; padding-bottom: 0.5em; }
+
+/* coloring */
+
+.lisp-bg { background-color: #F4F4F4 ; color: black; }
+.lisp-bg:hover { background-color: #F4F4F4 ; color: black; }
+
+.symbol { font-weight: bold; color: #770055; background-color : transparent; border: 0px; margin: 0px;}
+a.symbol:link { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; }
+a.symbol:active { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; }
+a.symbol:visited { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; }
+a.symbol:hover { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; }
+.special { font-weight: bold; color: #FF5000; background-color: inherit; }
+.keyword { font-weight: bold; color: #770000; background-color: inherit; }
+.comment { font-weight: normal; color: #007777; background-color: inherit; }
+.string  { font-weight: bold; color: #777777; background-color: inherit; }
+.character   { font-weight: bold; color: #0055AA; background-color: inherit; }
+.syntaxerror { font-weight: bold; color: #FF0000; background-color: inherit; }
+span.paren1 { font-weight: bold; color: #777777; }
+span.paren1:hover { color: #777777; background-color: #BAFFFF; }
+span.paren2 { color: #777777; }
+span.paren2:hover { color: #777777; background-color: #FFCACA; }
+span.paren3 { color: #777777; }
+span.paren3:hover { color: #777777; background-color: #FFFFBA; }
+span.paren4 { color: #777777; }
+span.paren4:hover { color: #777777; background-color: #CACAFF; }
+span.paren5 { color: #777777; }
+span.paren5:hover { color: #777777; background-color: #CAFFCA; }
+span.paren6 { color: #777777; }
+span.paren6:hover { color: #777777; background-color: #FFBAFF; }

Added: branches/xml-class-rework/thirdparty/cffi/examples/examples.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/examples/examples.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/examples/examples.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,78 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; examples.lisp --- Simple test examples of CFFI.
+;;;
+;;; Copyright (C) 2005, James Bielman  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+(defpackage #:cffi-examples
+  (:use #:cl #:cffi)
+  (:export
+   #:run-examples
+   #:sqrtf
+   #:getenv))
+
+(in-package #:cffi-examples)
+
+;; A simple libc function.
+(defcfun "sqrtf" :float
+  (n :float))
+
+;; This definition uses the STRING type translator to automatically
+;; convert Lisp strings to foreign strings and vice versa.
+(defcfun "getenv" :string
+  (name :string))
+
+;; Calling a varargs function.
+(defun sprintf-test ()
+  "Test calling a varargs function."
+  (with-foreign-pointer-as-string (buf 255 buf-size)
+    (foreign-funcall
+     "snprintf" :pointer buf :int buf-size
+     :string "%d %f #x%x!" :int 666 
+     :double (coerce pi 'double-float)
+     :unsigned-int #xcafebabe
+     :void)))
+
+;; Defining an emerated type.
+(defcenum test-enum
+  (:invalid 0)
+  (:positive 1)
+  (:negative -1))
+
+;; Use the absolute value function to test keyword/enum translation.
+(defcfun ("abs" c-abs) test-enum
+  (n test-enum))
+
+(defun cffi-version ()
+  (asdf:component-version (asdf:find-system 'cffi)))
+
+(defun run-examples ()
+  (format t "~&;;; CFFI version ~A on ~A ~A:~%"
+          (cffi-version) (lisp-implementation-type)
+          (lisp-implementation-version))
+  (format t "~&;; shell:             ~A~%" (getenv "SHELL"))
+  (format t "~&;; sprintf test:      ~A~%" (sprintf-test))
+  (format t "~&;; (c-abs :positive): ~A~%" (c-abs :positive))
+  (format t "~&;; (c-abs :negative): ~A~%" (c-abs :negative))
+  (force-output))

Added: branches/xml-class-rework/thirdparty/cffi/examples/gethostname.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/examples/gethostname.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/examples/gethostname.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,51 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; gethostname.lisp --- A simple CFFI example.
+;;;
+;;; Copyright (C) 2005, James Bielman  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+;;;# CFFI Example: gethostname binding
+;;;
+;;; This is a very simple CFFI example that illustrates calling a C
+;;; function that fills in a user-supplied string buffer.
+
+(defpackage #:cffi-example-gethostname
+  (:use #:common-lisp #:cffi)
+  (:export #:gethostname))
+
+(in-package #:cffi-example-gethostname)
+
+;;; Define the Lisp function %GETHOSTNAME to call the C 'gethostname'
+;;; function, which will fill BUF with up to BUFSIZE characters of the
+;;; system's hostname.
+(defcfun ("gethostname" %gethostname) :int
+  (buf :pointer)
+  (bufsize :int))
+
+;;; Define a Lispy interface to 'gethostname'.  The utility macro
+;;; WITH-FOREIGN-POINTER-AS-STRING is used to allocate a temporary
+;;; buffer and return it as a Lisp string.
+(defun gethostname ()
+  (with-foreign-pointer-as-string (buf 255 bufsize)
+    (%gethostname buf bufsize)))

Added: branches/xml-class-rework/thirdparty/cffi/examples/gettimeofday.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/examples/gettimeofday.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/examples/gettimeofday.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,87 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; gettimeofday.lisp --- Example CFFI binding to gettimeofday(2)
+;;;
+;;; Copyright (C) 2005, James Bielman  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+;;;# CFFI Example: gettimeofday binding
+;;;
+;;; This example illustrates the use of foreign structures, typedefs,
+;;; and using type translators to do checking of input and output
+;;; arguments to a foreign function.
+
+(defpackage #:cffi-example-gettimeofday
+  (:use #:common-lisp #:cffi #:cffi-utils)
+  (:export #:gettimeofday))
+
+(in-package #:cffi-example-gettimeofday)
+
+;;; Define the TIMEVAL structure used by 'gettimeofday'.  This assumes
+;;; that 'time_t' is a 'long' --- it would be nice if CFFI could
+;;; provide a proper :TIME-T type to help make this portable.
+(defcstruct timeval
+  (tv-sec :long)
+  (tv-usec :long))
+
+;;; A NULL-POINTER is a foreign :POINTER that must always be NULL.
+;;; Both a NULL pointer and NIL are legal values---any others will
+;;; result in a runtime error.
+(defctype null-pointer :pointer)
+
+;;; This type translator is used to ensure that a NULL-POINTER has a
+;;; null value.  It also converts NIL to a null pointer.
+(defmethod translate-to-foreign (value (name (eql 'null-pointer)))
+  (cond
+    ((null value) (null-pointer))
+    ((null-pointer-p value) value)
+    (t (error "~A is not a null pointer." value))))
+
+;;; The SYSCALL-RESULT type is an integer type used for the return
+;;; value of C functions that return -1 and set errno on errors.
+;;; Someday when CFFI has a portable interface for dealing with
+;;; 'errno', this error reporting can be more useful.
+(defctype syscall-result :int)
+
+;;; Type translator to check a SYSCALL-RESULT and signal a Lisp error
+;;; if the value is negative.
+(defmethod translate-from-foreign (value (name (eql 'syscall-result)))
+  (if (minusp value)
+      (error "System call failed with return value ~D." value)
+      value))
+
+;;; Define the Lisp function %GETTIMEOFDAY to call the C function
+;;; 'gettimeofday', passing a pointer to the TIMEVAL structure to fill
+;;; in.  The TZP parameter is deprecated and should be NULL --- we can
+;;; enforce this by using our NULL-POINTER type defined above.
+(defcfun ("gettimeofday" %gettimeofday) syscall-result
+  (tp :pointer)
+  (tzp null-pointer))
+
+;;; Define a Lispy interface to 'gettimeofday' that returns the
+;;; seconds and microseconds as multiple values.
+(defun gettimeofday ()
+  (with-foreign-object (tv 'timeval)
+    (%gettimeofday tv nil)
+    (with-foreign-slots ((tv-sec tv-usec) tv timeval)
+      (values tv-sec tv-usec))))

Added: branches/xml-class-rework/thirdparty/cffi/examples/run-examples.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/examples/run-examples.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/examples/run-examples.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,38 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; run-examples.lisp --- Simple script to run the examples.
+;;;
+;;; Copyright (C) 2005, James Bielman  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+(setf *load-verbose* nil *compile-verbose* nil)
+
+#+(and (not asdf) (or sbcl openmcl))
+(require "asdf")
+#+clisp
+(load "~/Downloads/asdf")
+
+(asdf:operate 'asdf:load-op 'cffi-examples :verbose nil)
+(cffi-examples:run-examples)
+(force-output)
+(quit)

Added: branches/xml-class-rework/thirdparty/cffi/examples/translator-test.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/examples/translator-test.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/examples/translator-test.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,108 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; translator-test.lisp --- Testing type translators.
+;;;
+;;; Copyright (C) 2005, James Bielman  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+(defpackage #:cffi-translator-test
+  (:use #:common-lisp #:cffi #:cffi-utils))
+
+(in-package #:cffi-translator-test)
+
+;;;# Verbose Pointer Translator
+;;;
+;;; This is a silly type translator that doesn't actually do any
+;;; translating, but it prints out a debug message when the pointer is
+;;; converted to/from its foreign representation.
+
+(defctype verbose-pointer :pointer)
+
+(defmethod translate-to-foreign (value (name (eql 'verbose-pointer)))
+  (format *debug-io* "~&;; to foreign: VERBOSE-POINTER: ~S~%" value)
+  value)
+
+(defmethod translate-from-foreign (value (name (eql 'verbose-pointer)))
+  (format *debug-io* "~&;; from foreign: VERBOSE-POINTER: ~S~%" value)
+  value)
+
+;;;# Verbose String Translator
+;;;
+;;; A VERBOSE-STRING is a typedef for a VERBOSE-POINTER except the
+;;; Lisp string is first converted to a C string.  If things are
+;;; working properly, both type translators should be called when
+;;; converting a Lisp string to/from a C string.
+;;;
+;;; The translators should be called most-specific-first when
+;;; translating to C, and most-specific-last when translating from C.
+
+(defctype verbose-string verbose-pointer)
+
+(defmethod translate-to-foreign ((s string) (name (eql 'verbose-string)))
+  (let ((value (foreign-string-alloc s)))
+    (format *debug-io* "~&;; to foreign: VERBOSE-STRING: ~S -> ~S~%" s value)
+    (values value t)))
+
+(defmethod translate-to-foreign (value (name (eql 'verbose-string)))
+  (if (pointerp value)
+      (progn
+        (format *debug-io* "~&;; to foreign: VERBOSE-STRING: ~S -> ~:*~S~%" value)
+        (values value nil))
+      (error "Cannot convert ~S to a foreign string: it is not a Lisp ~
+              string or pointer." value)))
+
+(defmethod translate-from-foreign (ptr (name (eql 'verbose-string)))
+  (let ((value (foreign-string-to-lisp ptr)))
+    (format *debug-io* "~&;; from foreign: VERBOSE-STRING: ~S -> ~S~%" ptr value)
+    value))
+
+(defmethod free-translated-object (ptr (name (eql 'verbose-string)) free-p)
+  (when free-p
+    (foreign-string-free ptr)))
+
+(defun test-verbose-string ()
+  (foreign-funcall "getenv" verbose-string "SHELL" verbose-string))
+
+;;;# Testing Chained Parameters
+
+(defctype inner-type :int)
+(defctype middle-type inner-type)
+(defctype outer-type middle-type)
+
+(defmethod translate-to-foreign (value (name (eql 'inner-type)))
+  (values value 1))
+
+(defmethod translate-to-foreign (value (name (eql 'middle-type)))
+  (values value 2))
+
+(defmethod translate-to-foreign (value (name (eql 'outer-type)))
+  (values value 3))
+
+(defmethod free-translated-object (value (name (eql 'inner-type)) param)
+  (format t "~&;; free inner-type ~A~%" param))
+
+(defmethod free-translated-object (value (name (eql 'middle-type)) param)
+  (format t "~&;; free middle-type ~A~%" param))
+
+(defmethod free-translated-object (value (name (eql 'outer-type)) param)
+  (format t "~&;; free outer-type ~A~%" param))

Added: branches/xml-class-rework/thirdparty/cffi/scripts/release.sh
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/scripts/release.sh	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/scripts/release.sh	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,45 @@
+#! /bin/sh
+#
+# release.sh --- Create a signed tarball release for ASDF-INSTALL.
+#
+# Copyright (C) 2005, James Bielman  
+#
+# Permission is hereby granted, free of charge, to any person
+# obtaining a copy of this software and associated documentation
+# files (the "Software"), to deal in the Software without
+# restriction, including without limitation the rights to use, copy,
+# modify, merge, publish, distribute, sublicense, and/or sell copies
+# of the Software, and to permit persons to whom the Software is
+# furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be
+# included in all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+# NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+# HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+# DEALINGS IN THE SOFTWARE.
+#
+
+VERSION=${VERSION:=`date +"%Y%m%d"`}
+TARBALL_NAME="cffi_$VERSION"
+TARBALL="$TARBALL_NAME.tar.gz"
+SIGNATURE="$TARBALL.asc"
+RELEASE_DIR=${RELEASE_DIR:="/project/cffi/public_html/releases"}
+
+echo "Creating distribution..."
+darcs dist -d "$TARBALL_NAME"
+
+echo "Signing tarball..."
+gpg -b -a "$TARBALL_NAME.tar.gz"
+
+echo "Copying tarball to web server..."
+scp "$TARBALL" "$SIGNATURE" common-lisp.net:"$RELEASE_DIR"
+
+echo "Uploaded $TARBALL and $SIGNATURE."
+echo "Don't forget to update the link on the CLiki page!"
+


Property changes on: branches/xml-class-rework/thirdparty/cffi/scripts/release.sh
___________________________________________________________________
Name: svn:executable
   + *
Name: svn:eol-style
   + native

Added: branches/xml-class-rework/thirdparty/cffi/src/cffi-allegro.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/src/cffi-allegro.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/src/cffi-allegro.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,414 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; cffi-allegro.lisp --- CFFI-SYS implementation for Allegro CL.
+;;;
+;;; Copyright (C) 2005, Luis Oliveira  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+;;;# Administrivia
+
+(defpackage #:cffi-sys
+  (:use #:common-lisp #:cffi-utils)
+  (:export
+   #:canonicalize-symbol-name-case
+   #:pointerp
+   #:pointer-eq
+   #:null-pointer
+   #:null-pointer-p
+   #:inc-pointer
+   #:make-pointer
+   #:pointer-address
+   #:%foreign-alloc
+   #:foreign-free
+   #:with-foreign-pointer
+   #:%foreign-funcall
+   #:%foreign-funcall-pointer
+   #:%foreign-type-alignment
+   #:%foreign-type-size
+   #:%load-foreign-library
+   #:%close-foreign-library
+   #:%mem-ref
+   #:%mem-set
+   ;#:make-shareable-byte-vector
+   ;#:with-pointer-to-vector-data
+   #:foreign-symbol-pointer
+   #:defcfun-helper-forms
+   #:%defcallback
+   #:%callback))
+
+(in-package #:cffi-sys)
+
+;;;# Features
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (mapc (lambda (feature) (pushnew feature *features*))
+        '(;; Backend mis-features.
+          cffi-features:no-long-long
+          ;; OS/CPU features.
+          #+macosx     cffi-features:darwin
+          #+unix       cffi-features:unix
+          #+mswindows  cffi-features:windows
+          #+powerpc    cffi-features:ppc32
+          #+x86        cffi-features:x86
+          #+x86-64     cffi-features:x86-64
+          )))
+
+;;; Symbol case.
+
+(defun canonicalize-symbol-name-case (name)
+  (declare (string name))
+  (if (eq excl:*current-case-mode* :case-sensitive-lower)
+      (string-downcase name)
+      (string-upcase name)))
+
+;;;# Basic Pointer Operations
+
+(defun pointerp (ptr)
+  "Return true if PTR is a foreign pointer."
+  (integerp ptr))
+
+(defun pointer-eq (ptr1 ptr2)
+  "Return true if PTR1 and PTR2 point to the same address."
+  (eql ptr1 ptr2))
+
+(defun null-pointer ()
+  "Return a null pointer."
+  0)
+
+(defun null-pointer-p (ptr)
+  "Return true if PTR is a null pointer."
+  (zerop ptr))
+
+(defun inc-pointer (ptr offset)
+  "Return a pointer pointing OFFSET bytes past PTR."
+  (+ ptr offset))
+
+(defun make-pointer (address)
+  "Return a pointer pointing to ADDRESS."
+  address)
+
+(defun pointer-address (ptr)
+  "Return the address pointed to by PTR."
+  ptr)
+
+;;;# Allocation
+;;;
+;;; Functions and macros for allocating foreign memory on the stack
+;;; and on the heap.  The main CFFI package defines macros that wrap
+;;; FOREIGN-ALLOC and FOREIGN-FREE in UNWIND-PROTECT for the common usage
+;;; when the memory has dynamic extent.
+
+(defun %foreign-alloc (size)
+  "Allocate SIZE bytes on the heap and return a pointer."
+  (ff:allocate-fobject :char :c size))
+
+(defun foreign-free (ptr)
+  "Free a PTR allocated by FOREIGN-ALLOC."
+  (ff:free-fobject ptr))
+
+(defmacro with-foreign-pointer ((var size &optional size-var) &body body)
+  "Bind VAR to SIZE bytes of foreign memory during BODY.  The
+pointer in VAR is invalid beyond the dynamic extent of BODY, and
+may be stack-allocated if supported by the implementation.  If
+SIZE-VAR is supplied, it will be bound to SIZE during BODY."
+  (unless size-var
+    (setf size-var (gensym "SIZE")))
+  `(let ((,size-var ,size))
+     (declare (ignorable ,size-var))
+     (ff:with-stack-fobject (,var :char :c ,size-var)
+       , at body)))
+     
+;;;# Shareable Vectors
+;;;
+;;; This interface is very experimental.  WITH-POINTER-TO-VECTOR-DATA
+;;; should be defined to perform a copy-in/copy-out if the Lisp
+;;; implementation can't do this.
+
+;(defun make-shareable-byte-vector (size)
+;  "Create a Lisp vector of SIZE bytes can passed to
+;WITH-POINTER-TO-VECTOR-DATA."
+;  (make-array size :element-type '(unsigned-byte 8)))
+;
+;(defmacro with-pointer-to-vector-data ((ptr-var vector) &body body)
+;  "Bind PTR-VAR to a foreign pointer to the data in VECTOR."
+;  `(sb-sys:without-gcing
+;     (let ((,ptr-var (sb-sys:vector-sap ,vector)))
+;       , at body)))
+
+;;;# Dereferencing
+
+(defun convert-foreign-type (type-keyword &optional (context :normal))
+  "Convert a CFFI type keyword to an Allegro type."
+  (ecase type-keyword
+    (:char             :char)
+    (:unsigned-char    :unsigned-char)
+    (:short            :short)
+    (:unsigned-short   :unsigned-short)
+    (:int              :int)
+    (:unsigned-int     :unsigned-int)
+    (:long             :long)
+    (:unsigned-long    :unsigned-long)
+    (:float            :float)
+    (:double           :double)
+    (:pointer          (ecase context
+                         (:normal '(* :void))
+                         (:funcall :foreign-address)))
+    (:void             :void)))
+
+(defun %mem-ref (ptr type &optional (offset 0))
+  "Dereference an object of TYPE at OFFSET bytes from PTR."
+  (unless (zerop offset)
+    (setf ptr (inc-pointer ptr offset)))
+  (ff:fslot-value-typed (convert-foreign-type type) :c ptr))
+
+;;; Compiler macro to open-code the call to FSLOT-VALUE-TYPED when the
+;;; CFFI type is constant.  Allegro does its own transformation on the
+;;; call that results in efficient code.
+(define-compiler-macro %mem-ref (&whole form ptr type &optional (off 0))
+  (if (constantp type)
+      (let ((ptr-form (if (eql off 0) ptr `(+ ,ptr ,off))))
+        `(ff:fslot-value-typed ',(convert-foreign-type (eval type))
+                               :c ,ptr-form))
+      form))
+
+(defun %mem-set (value ptr type &optional (offset 0))
+  "Set the object of TYPE at OFFSET bytes from PTR."
+  (unless (zerop offset)
+    (setf ptr (inc-pointer ptr offset)))
+  (setf (ff:fslot-value-typed (convert-foreign-type type) :c ptr) value))
+
+;;; Compiler macro to open-code the call to (SETF FSLOT-VALUE-TYPED)
+;;; when the CFFI type is constant.  Allegro does its own
+;;; transformation on the call that results in efficient code.
+(define-compiler-macro %mem-set (&whole form val ptr type &optional (off 0))
+  (if (constantp type)
+      (once-only (val)
+        (let ((ptr-form (if (eql off 0) ptr `(+ ,ptr ,off))))
+          `(setf (ff:fslot-value-typed ',(convert-foreign-type (eval type))
+                                       :c ,ptr-form) ,val)))
+      form))
+
+;;;# Calling Foreign Functions
+
+(defun %foreign-type-size (type-keyword)
+  "Return the size in bytes of a foreign type."
+  (ff:sizeof-fobject (convert-foreign-type type-keyword)))
+
+(defun %foreign-type-alignment (type-keyword)
+  "Returns the alignment in bytes of a foreign type."
+  #+(and powerpc macosx32)
+  (when (eq type-keyword :double)
+    (return-from %foreign-type-alignment 8))
+  ;; No override necessary for the remaining types....
+  (ff::sized-ftype-prim-align
+   (ff::iforeign-type-sftype
+    (ff:get-foreign-type
+     (convert-foreign-type type-keyword)))))
+
+(defun foreign-funcall-type-and-args (args)
+  "Returns a list of types, list of args and return type."
+  (let ((return-type :void))
+    (loop for (type arg) on args by #'cddr
+          if arg collect (convert-foreign-type type :funcall) into types
+          and collect arg into fargs
+          else do (setf return-type (convert-foreign-type type :funcall))
+          finally (return (values types fargs return-type)))))
+
+(defun convert-to-lisp-type (type)
+  (if (equal '(* :void) type)
+      'integer
+      (ecase type
+        (:char 'signed-byte)
+        (:unsigned-char 'integer) ;'unsigned-byte)
+        ((:short
+          :unsigned-short
+          :int
+          :unsigned-int
+          :long
+          :unsigned-long) 'integer)
+        (:float 'single-float)
+        (:double 'double-float)
+        (:foreign-address :foreign-address)
+        (:void 'null))))
+
+(defun foreign-allegro-type (type)
+  (if (eq type :foreign-address)
+      nil
+      type))
+
+(defun allegro-type-pair (type)
+  (list (foreign-allegro-type type)
+        (convert-to-lisp-type type)))
+
+#+ignore
+(defun note-named-foreign-function (symbol name types rettype)
+  "Give Allegro's compiler a hint to perform a direct call."
+  `(eval-when (:compile-toplevel :load-toplevel :execute)
+     (setf (get ',symbol 'system::direct-ff-call)
+           (list '(,name :language :c)
+                 t  ; callback
+                 :c ; convention
+                 ;; return type '(:c-type lisp-type)
+                 ',(allegro-type-pair (convert-foreign-type rettype :funcall))
+                 ;; arg types '({(:c-type lisp-type)}*)
+                 '(,@(loop for type in types
+                           collect (allegro-type-pair
+                                    (convert-foreign-type type :funcall))))
+                 nil ; arg-checking
+                 ff::ep-flag-never-release))))
+
+(defmacro %foreign-funcall (name &rest args)
+  (multiple-value-bind (types fargs rettype)
+      (foreign-funcall-type-and-args args)
+    `(system::ff-funcall
+      (load-time-value (excl::determine-foreign-address
+                        '(,name :language :c)
+                        ff::ep-flag-never-release
+                        nil ; method-index
+                        ))
+      ;; arg types {'(:c-type lisp-type) argN}*
+      ,@(mapcan (lambda (type arg)
+                  `(',(allegro-type-pair type) ,arg))
+                types fargs)
+      ;; return type '(:c-type lisp-type)
+      ',(allegro-type-pair rettype))))
+
+(defun defcfun-helper-forms (name lisp-name rettype args types)
+  "Return 2 values for DEFCFUN. A prelude form and a caller form."
+  (let ((ff-name (intern (format nil "%cffi-foreign-function/~A" lisp-name))))
+    (values
+     `(ff:def-foreign-call (,ff-name ,name)
+          ,(mapcar (lambda (ty) 
+                     (let ((allegro-type (convert-foreign-type ty)))
+                       (list (gensym) allegro-type
+                             (convert-to-lisp-type allegro-type))))
+                   types)
+        :returning ,(allegro-type-pair
+                     (convert-foreign-type rettype :funcall))
+        ;; Don't use call-direct when there are no arguments.
+        ,@(unless (null args) '(:call-direct t))
+        :arg-checking nil
+        :strings-convert nil)
+     `(,ff-name , at args))))
+
+;;; See doc/allegro-internals.txt for a clue about entry-vec.
+(defmacro %foreign-funcall-pointer (ptr &rest args)
+  (multiple-value-bind (types fargs rettype)
+      (foreign-funcall-type-and-args args)
+    (with-unique-names (entry-vec)
+      `(let ((,entry-vec (excl::make-entry-vec-boa)))
+         (setf (aref ,entry-vec 1) ,ptr) ; set jump address
+         (system::ff-funcall
+          ,entry-vec
+          ;; arg types {'(:c-type lisp-type) argN}*
+          ,@(mapcan (lambda (type arg)
+                      `(',(allegro-type-pair type) ,arg))
+                    types fargs)
+          ;; return type '(:c-type lisp-type)
+          ',(allegro-type-pair rettype)))))) 
+
+;;;# Callbacks
+
+;;; The *CALLBACKS* hash table contains information about a callback
+;;; for the Allegro FFI.  The key is the name of the CFFI callback,
+;;; and the value is a cons, the car containing the symbol the
+;;; callback was defined on in the CFFI-CALLBACKS package, the cdr
+;;; being an Allegro FFI pointer (a fixnum) that can be passed to C
+;;; functions.
+;;;
+;;; These pointers must be restored when a saved Lisp image is loaded.
+;;; The RESTORE-CALLBACKS function is added to *RESTART-ACTIONS* to
+;;; re-register the callbacks during Lisp startup.
+(defvar *callbacks* (make-hash-table))
+
+;;; Register a callback in the *CALLBACKS* hash table.
+(defun register-callback (cffi-name callback-name)
+  (setf (gethash cffi-name *callbacks*)
+        (cons callback-name (ff:register-foreign-callable
+                             callback-name :reuse t))))
+
+;;; Restore the saved pointers in *CALLBACKS* when loading an image.
+(defun restore-callbacks ()
+  (maphash (lambda (key value)
+             (register-callback key (car value)))
+           *callbacks*))
+
+;;; Arrange for RESTORE-CALLBACKS to run when a saved image containing
+;;; CFFI is restarted.
+(eval-when (:load-toplevel :execute)
+  (pushnew 'restore-callbacks excl:*restart-actions*))
+  
+;;; Create a package to contain the symbols for callback functions.
+(defpackage #:cffi-callbacks
+  (:use))
+
+(defun intern-callback (name)
+  (intern (format nil "~A::~A" (package-name (symbol-package name))
+                  (symbol-name name))
+          '#:cffi-callbacks))
+
+(defmacro %defcallback (name rettype arg-names arg-types &body body)
+  (declare (ignore rettype))
+  (let ((cb-name (intern-callback name)))
+    `(progn
+       (ff:defun-foreign-callable ,cb-name
+           ,(mapcar (lambda (sym type) (list sym (convert-foreign-type type)))
+                    arg-names arg-types)
+         (declare (:convention :c))
+         , at body)
+       (register-callback ',name ',cb-name))))
+
+;;; Return the saved Lisp callback pointer from *CALLBACKS* for the
+;;; CFFI callback named NAME.
+(defun %callback (name)
+  (or (cdr (gethash name *callbacks*))
+      (error "Undefined callback: ~S" name)))
+
+;;;# Loading and Closing Foreign Libraries
+
+(defun %load-foreign-library (name)
+  "Load the foreign library NAME."
+  ;; ACL 8.0 honors the :FOREIGN option and always tries to foreign load
+  ;; the argument. However, previous versions do not and will only
+  ;; foreign load the argument if its type is a member of the
+  ;; EXCL::*LOAD-FOREIGN-TYPES* list. Therefore, we bind that special
+  ;; to a list containing whatever type NAME has.
+  (let ((excl::*load-foreign-types*
+         (list (pathname-type (parse-namestring name)))))
+    (ignore-errors #+(version>= 7) (load name :foreign t)
+                   #-(version>= 7) (load name))))
+
+(defun %close-foreign-library (name)
+  "Close the foreign library NAME."
+  (ff:unload-foreign-library name))
+
+;;;# Foreign Globals
+
+(defun convert-external-name (name)
+  "Add an underscore to NAME if necessary for the ABI."
+  #+macosx (concatenate 'string "_" name)
+  #-macosx name)
+
+(defun foreign-symbol-pointer (name)
+  "Returns a pointer to a foreign symbol NAME."
+  (prog1 (ff:get-entry-point (convert-external-name name))))
\ No newline at end of file

Added: branches/xml-class-rework/thirdparty/cffi/src/cffi-clisp.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/src/cffi-clisp.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/src/cffi-clisp.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,333 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; cffi-clisp.lisp --- CFFI-SYS implementation for CLISP.
+;;;
+;;; Copyright (C) 2005, James Bielman  
+;;;           (C) 2005, Joerg Hoehle  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+;;;# Administrivia
+
+(defpackage #:cffi-sys
+  (:use #:common-lisp #:cffi-utils)
+  (:export
+   #:canonicalize-symbol-name-case
+   #:pointerp
+   #:pointer-eq
+   #:null-pointer
+   #:null-pointer-p
+   #:inc-pointer
+   #:make-pointer
+   #:pointer-address
+   #:%foreign-alloc
+   #:foreign-free
+   #:with-foreign-pointer
+   #:%foreign-funcall
+   #:%foreign-funcall-pointer
+   #:%foreign-type-alignment
+   #:%foreign-type-size
+   #:%load-foreign-library
+   #:%close-foreign-library
+   #:%mem-ref
+   #:%mem-set
+   #:foreign-symbol-pointer
+   #:%defcallback
+   #:%callback))
+
+(in-package #:cffi-sys)
+
+;;; FIXME: long-long could be supported anyway on 64-bit machines. --luis
+
+;;;# Features
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (mapc (lambda (feature) (pushnew feature *features*))
+        '(;; Backend mis-features.
+          cffi-features:no-long-long
+          ;; OS/CPU features.
+          #+macos  cffi-features:darwin
+          #+unix   cffi-features:unix
+          #+win32  cffi-features:windows
+          ))
+  (cond ((string-equal (machine-type) "X86_64")
+         (pushnew 'cffi-features:x86-64 *features*))
+        ((member :pc386 *features*)
+         (pushnew 'cffi-features:x86 *features*))
+        ;; FIXME: probably catches PPC64 as well
+        ((string-equal (machine-type) "POWER MACINTOSH")
+         (pushnew 'cffi-features:ppc32 *features*))))
+
+;;; Symbol case.
+
+(defun canonicalize-symbol-name-case (name)
+  (declare (string name))
+  (string-upcase name))
+
+;;;# Built-In Foreign Types
+
+(defun convert-foreign-type (type)
+  "Convert a CFFI built-in type keyword to a CLisp FFI type."
+  (ecase type
+    (:char 'ffi:char)
+    (:unsigned-char 'ffi:uchar)
+    (:short 'ffi:short)
+    (:unsigned-short 'ffi:ushort)
+    (:int 'ffi:int)
+    (:unsigned-int 'ffi:uint)
+    (:long 'ffi:long)
+    (:unsigned-long 'ffi:ulong)
+    (:float 'ffi:single-float)
+    (:double 'ffi:double-float)
+    ;; Clisp's FFI:C-POINTER converts NULL to NIL. For now
+    ;; we have a workaround in the pointer operations...
+    (:pointer 'ffi:c-pointer)
+    (:void nil)))
+
+(defun %foreign-type-size (type)
+  "Return the size in bytes of objects having foreign type TYPE."
+  (nth-value 0 (ffi:sizeof (convert-foreign-type type))))
+
+;; Remind me to buy a beer for whoever made getting the alignment
+;; of foreign types part of the public interface in CLisp. :-)
+(defun %foreign-type-alignment (type)
+  "Return the structure alignment in bytes of foreign TYPE."
+  #+(and cffi-features:darwin cffi-features:ppc32)
+  (when (eq type :double)
+    (return-from %foreign-type-alignment 8))
+  ;; Override not necessary for the remaining types...
+  (nth-value 1 (ffi:sizeof (convert-foreign-type type))))
+
+;;;# Basic Pointer Operations
+
+(defun pointerp (ptr)
+  "Return true if PTR is a foreign pointer."
+  (or (null ptr) (typep ptr 'ffi:foreign-address)))
+
+(defun pointer-eq (ptr1 ptr2)
+  "Return true if PTR1 and PTR2 point to the same address."
+  (eql (ffi:foreign-address-unsigned ptr1)
+       (ffi:foreign-address-unsigned ptr2)))
+
+(defun null-pointer ()
+  "Return a null foreign pointer."
+  (ffi:unsigned-foreign-address 0))
+
+(defun null-pointer-p (ptr)
+  "Return true if PTR is a null foreign pointer."
+  (or (null ptr) (zerop (ffi:foreign-address-unsigned ptr))))
+
+(defun inc-pointer (ptr offset)
+  "Return a pointer pointing OFFSET bytes past PTR."
+  (ffi:unsigned-foreign-address
+   (+ offset (if (null ptr) 0 (ffi:foreign-address-unsigned ptr)))))
+
+(defun make-pointer (address)
+  "Return a pointer pointing to ADDRESS."
+  (ffi:unsigned-foreign-address address))
+
+(defun pointer-address (ptr)
+  "Return the address pointed to by PTR."
+  (ffi:foreign-address-unsigned ptr))
+
+;;;# Foreign Memory Allocation
+
+(defun %foreign-alloc (size)
+  "Allocate SIZE bytes of foreign-addressable memory and return a
+pointer to the allocated block.  An implementation-specific error
+is signalled if the memory cannot be allocated."
+  (ffi:foreign-address (ffi:allocate-shallow 'ffi:uint8 :count size)))
+
+(defun foreign-free (ptr)
+  "Free a pointer PTR allocated by FOREIGN-ALLOC.  The results
+are undefined if PTR is used after being freed."
+  (ffi:foreign-free ptr))
+
+(defmacro with-foreign-pointer ((var size &optional size-var) &body body)
+  "Bind VAR to a pointer to SIZE bytes of foreign-addressable
+memory during BODY.  Both PTR and the memory block pointed to
+have dynamic extent and may be stack allocated if supported by
+the implementation.  If SIZE-VAR is supplied, it will be bound to
+SIZE during BODY."
+  (unless size-var
+    (setf size-var (gensym "SIZE")))
+  (let ((obj-var (gensym)))
+    `(let ((,size-var ,size))
+       (ffi:with-foreign-object
+           (,obj-var `(ffi:c-array ffi:uint8 ,,size-var))
+         (let ((,var (ffi:foreign-address ,obj-var)))
+           , at body)))))
+
+;;;# Memory Access
+
+(defun %mem-ref (ptr type &optional (offset 0))
+  "Dereference a pointer OFFSET bytes from PTR to an object of
+built-in foreign TYPE.  Returns the object as a foreign pointer
+or Lisp number."
+  (ffi:memory-as ptr (convert-foreign-type type) offset))
+
+(define-compiler-macro %mem-ref (&whole form ptr type &optional (offset 0))
+  "Compiler macro to open-code when TYPE is constant."
+  (if (constantp type)
+      `(ffi:memory-as ,ptr ',(convert-foreign-type (eval type)) ,offset)
+      form))
+
+(defun %mem-set (value ptr type &optional (offset 0))
+  "Set a pointer OFFSET bytes from PTR to an object of built-in
+foreign TYPE to VALUE."
+  (setf (ffi:memory-as ptr (convert-foreign-type type) offset) value))
+
+(define-compiler-macro %mem-set
+    (&whole form value ptr type &optional (offset 0))
+  (if (constantp type)
+      ;; (setf (ffi:memory-as) value) is exported, but not so nice
+      ;; w.r.t. the left to right evaluation rule
+      `(ffi::write-memory-as ,value ,ptr ',(convert-foreign-type (eval type)) ,offset)
+      form))
+
+;;;# Foreign Function Calling
+
+(defun parse-foreign-funcall-args (args)
+  "Return three values, a list of CLisp FFI types, a list of
+values to pass to the function, and the CLisp FFI return type."
+  (let ((return-type nil))
+    (loop for (type arg) on args by #'cddr
+          if arg collect (list (gensym) (convert-foreign-type type)) into types
+          and collect arg into fargs
+          else do (setf return-type (convert-foreign-type type))
+          finally (return (values types fargs return-type)))))
+
+(defmacro %foreign-funcall (name &rest args)
+  "Invoke a foreign function called NAME, taking pairs of
+foreign-type/value pairs from ARGS.  If a single element is left
+over at the end of ARGS, it specifies the foreign return type of
+the function call."
+  (multiple-value-bind (types fargs rettype)
+      (parse-foreign-funcall-args args)
+    (let ((ctype `(ffi:c-function (:arguments , at types)
+                                  (:return-type ,rettype)
+                                  (:language :stdc))))
+      `(funcall
+        (load-time-value
+         (multiple-value-bind (ff error)
+             (ignore-errors
+               (ffi::foreign-library-function
+                ,name (ffi::foreign-library :default)
+                nil (ffi:parse-c-type ',ctype)))
+           (or ff
+               (warn (format nil "~?"
+                             (simple-condition-format-control error)
+                             (simple-condition-format-arguments error)))))) 
+        , at fargs))))
+
+(defmacro %foreign-funcall-pointer (ptr &rest args)
+  "Similar to %foreign-funcall but takes a pointer instead of a string."
+  (multiple-value-bind (types fargs rettype)
+      (parse-foreign-funcall-args args)
+    `(funcall (ffi:foreign-function ,ptr
+                                    (load-time-value
+                                     (ffi:parse-c-type
+                                      '(ffi:c-function
+                                        (:arguments , at types)
+                                        (:return-type ,rettype)
+                                        (:language :stdc)))))
+              , at fargs)))
+
+;;;# Callbacks
+
+;;; *CALLBACKS* contains the callbacks defined by the CFFI DEFCALLBACK
+;;; macro.  The symbol naming the callback is the key, and the value
+;;; is a list containing a Lisp function, the parsed CLISP FFI type of
+;;; the callback, and a saved pointer that should not persist across
+;;; saved images.
+(defvar *callbacks* (make-hash-table))
+
+;;; Return a CLISP FFI function type for a CFFI callback function
+;;; given a return type and list of argument names and types.
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun callback-type (rettype arg-names arg-types)
+    (ffi:parse-c-type
+     `(ffi:c-function
+       (:arguments ,@(mapcar (lambda (sym type)
+                               (list sym (convert-foreign-type type)))
+                             arg-names arg-types))
+       (:return-type ,(convert-foreign-type rettype))
+       (:language :stdc)))))
+
+;;; Register and create a callback function.
+(defun register-callback (name function parsed-type)
+  (setf (gethash name *callbacks*)
+        (list function parsed-type
+              (ffi:with-foreign-object (ptr 'ffi:c-pointer)
+                ;; Create callback by converting Lisp function to foreign
+                (setf (ffi:memory-as ptr parsed-type) function)
+                (ffi:foreign-value ptr)))))
+
+;;; Restore all saved callback pointers when restarting the Lisp
+;;; image.  This is pushed onto CUSTOM:*INIT-HOOKS*.
+;;; Needs clisp > 2.35, bugfix 2005-09-29
+(defun restore-callback-pointers ()
+  (maphash
+   (lambda (name list)
+     (register-callback name (first list) (second list)))
+   *callbacks*))
+
+;;; Add RESTORE-CALLBACK-POINTERS to the lists of functions to run
+;;; when an image is restarted.
+(eval-when (:load-toplevel :execute)
+  (pushnew 'restore-callback-pointers custom:*init-hooks*))
+
+;;; Define a callback function NAME to run BODY with arguments
+;;; ARG-NAMES translated according to ARG-TYPES and the return type
+;;; translated according to RETTYPE.  Obtain a pointer that can be
+;;; passed to C code for this callback by calling %CALLBACK.
+(defmacro %defcallback (name rettype arg-names arg-types &body body)
+  `(register-callback ',name (lambda ,arg-names , at body)
+                      ,(callback-type rettype arg-names arg-types)))
+
+;;; Look up the name of a callback and return a pointer that can be
+;;; passed to a C function.  Signals an error if no callback is
+;;; defined called NAME.
+(defun %callback (name)
+  (multiple-value-bind (list winp) (gethash name *callbacks*)
+    (unless winp
+      (error "Undefined callback: ~S" name))
+    (third list)))
+
+;;;# Loading and Closing Foreign Libraries
+
+(defun %load-foreign-library (name)
+  "Load a foreign library from NAME."
+  (ffi::foreign-library name))
+
+(defun %close-foreign-library (name)
+  "Close a foreign library NAME."
+  (ffi:close-foreign-library name))
+
+;;;# Foreign Globals
+
+(defun foreign-symbol-pointer (name)
+  "Returns a pointer to a foreign symbol NAME."
+  (prog1 (ignore-errors
+           (ffi:foreign-address
+            (ffi::foreign-library-variable
+             name (ffi::foreign-library :default) nil nil)))))
\ No newline at end of file

Added: branches/xml-class-rework/thirdparty/cffi/src/cffi-cmucl.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/src/cffi-cmucl.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/src/cffi-cmucl.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,347 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; cffi-sbcl.lisp --- CFFI-SYS implementation for CMU CL.
+;;;
+;;; Copyright (C) 2005, James Bielman  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+;;;# Administrivia
+
+(defpackage #:cffi-sys
+  (:use #:common-lisp #:alien #:c-call #:cffi-utils)
+  (:export
+   #:canonicalize-symbol-name-case
+   #:pointerp
+   #:pointer-eq
+   #:null-pointer
+   #:null-pointer-p
+   #:inc-pointer
+   #:make-pointer
+   #:pointer-address
+   #:%foreign-alloc
+   #:foreign-free
+   #:with-foreign-pointer
+   #:%foreign-funcall
+   #:%foreign-funcall-pointer
+   #:%foreign-type-alignment
+   #:%foreign-type-size
+   #:%load-foreign-library
+   #:%close-foreign-library
+   #:%mem-ref
+   #:%mem-set
+   #:make-shareable-byte-vector
+   #:with-pointer-to-vector-data
+   #:foreign-symbol-pointer
+   #:%defcallback
+   #:%callback))
+
+(in-package #:cffi-sys)
+
+;;;# Features
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (mapc (lambda (feature) (pushnew feature *features*))
+        '(;; OS/CPU features.
+          #+darwin  cffi-features:darwin
+          #+unix    cffi-features:unix
+          #+x86     cffi-features:x86
+          #+(and ppc (not ppc64)) cffi-features:ppc32
+          )))
+
+;;; Symbol case.
+
+(defun canonicalize-symbol-name-case (name)
+  (declare (string name))
+  (string-upcase name))
+
+;;;# Basic Pointer Operations
+
+(declaim (inline pointerp))
+(defun pointerp (ptr)
+  "Return true if PTR is a foreign pointer."
+  (sys:system-area-pointer-p ptr))
+
+(declaim (inline pointer-eq))
+(defun pointer-eq (ptr1 ptr2)
+  "Return true if PTR1 and PTR2 point to the same address."
+  (sys:sap= ptr1 ptr2))
+
+(declaim (inline null-pointer))
+(defun null-pointer ()
+  "Construct and return a null pointer."
+  (sys:int-sap 0))
+
+(declaim (inline null-pointer-p))
+(defun null-pointer-p (ptr)
+  "Return true if PTR is a null pointer."
+  (zerop (sys:sap-int ptr)))
+
+(declaim (inline inc-pointer))
+(defun inc-pointer (ptr offset)
+  "Return a pointer pointing OFFSET bytes past PTR."
+  (sys:sap+ ptr offset))
+
+(declaim (inline make-pointer)) 
+(defun make-pointer (address)
+  "Return a pointer pointing to ADDRESS."
+  (sys:int-sap address))
+
+(declaim (inline pointer-address))
+(defun pointer-address (ptr)
+  "Return the address pointed to by PTR."
+  (sys:sap-int ptr))
+
+(defmacro with-foreign-pointer ((var size &optional size-var) &body body)
+  "Bind VAR to SIZE bytes of foreign memory during BODY.  The
+pointer in VAR is invalid beyond the dynamic extent of BODY, and
+may be stack-allocated if supported by the implementation.  If
+SIZE-VAR is supplied, it will be bound to SIZE during BODY."
+  (unless size-var
+    (setf size-var (gensym "SIZE")))
+  ;; If the size is constant we can stack-allocate.
+  (if (constantp size)
+      (let ((alien-var (gensym "ALIEN")))
+        `(with-alien ((,alien-var (array (unsigned 8) ,(eval size))))
+           (let ((,size-var ,(eval size))
+                 (,var (alien-sap ,alien-var)))
+             (declare (ignorable ,size-var))
+             , at body)))
+      `(let* ((,size-var ,size)
+              (,var (%foreign-alloc ,size-var)))
+         (unwind-protect
+              (progn , at body)
+           (foreign-free ,var)))))
+
+;;;# Allocation
+;;;
+;;; Functions and macros for allocating foreign memory on the stack
+;;; and on the heap.  The main CFFI package defines macros that wrap
+;;; FOREIGN-ALLOC and FOREIGN-FREE in UNWIND-PROTECT for the common usage
+;;; when the memory has dynamic extent.
+
+(defun %foreign-alloc (size)
+  "Allocate SIZE bytes on the heap and return a pointer."
+  (declare (type (unsigned-byte 32) size))
+  (alien-funcall
+   (extern-alien
+    "malloc"
+    (function system-area-pointer unsigned))
+   size))
+
+(defun foreign-free (ptr)
+  "Free a PTR allocated by FOREIGN-ALLOC."
+  (declare (type system-area-pointer ptr))
+  (alien-funcall
+   (extern-alien
+    "free"
+    (function (values) system-area-pointer))
+   ptr))
+
+;;;# Shareable Vectors
+;;;
+;;; This interface is very experimental.  WITH-POINTER-TO-VECTOR-DATA
+;;; should be defined to perform a copy-in/copy-out if the Lisp
+;;; implementation can't do this.
+
+(defun make-shareable-byte-vector (size)
+  "Create a Lisp vector of SIZE bytes that can passed to
+WITH-POINTER-TO-VECTOR-DATA."
+  (make-array size :element-type '(unsigned-byte 8)))
+
+(defmacro with-pointer-to-vector-data ((ptr-var vector) &body body)
+  "Bind PTR-VAR to a foreign pointer to the data in VECTOR."
+  `(sys:without-gcing
+     (let ((,ptr-var (sys:vector-sap ,vector)))
+       , at body)))
+
+;;;# Dereferencing
+
+;;; Define the %MEM-REF and %MEM-SET functions, as well as compiler
+;;; macros that optimize the case where the type keyword is constant
+;;; at compile-time.
+(defmacro define-mem-accessors (&body pairs)
+  `(progn
+    (defun %mem-ref (ptr type &optional (offset 0))
+      (ecase type
+        ,@(loop for (keyword fn) in pairs
+                collect `(,keyword (,fn ptr offset)))))
+    (defun %mem-set (value ptr type &optional (offset 0))
+      (ecase type
+        ,@(loop for (keyword fn) in pairs
+                collect `(,keyword (setf (,fn ptr offset) value)))))
+    (define-compiler-macro %mem-ref
+        (&whole form ptr type &optional (offset 0))
+      (if (constantp type)
+          (ecase (eval type)
+            ,@(loop for (keyword fn) in pairs
+                    collect `(,keyword `(,',fn ,ptr ,offset))))
+          form))
+    (define-compiler-macro %mem-set
+        (&whole form value ptr type &optional (offset 0))
+      (if (constantp type)
+          (once-only (value)
+            (ecase (eval type)
+              ,@(loop for (keyword fn) in pairs
+                      collect `(,keyword `(setf (,',fn ,ptr ,offset)
+                                                ,value)))))
+          form))))
+
+(define-mem-accessors
+  (:char sys:signed-sap-ref-8)
+  (:unsigned-char sys:sap-ref-8)
+  (:short sys:signed-sap-ref-16)
+  (:unsigned-short sys:sap-ref-16)
+  (:int sys:signed-sap-ref-32)
+  (:unsigned-int sys:sap-ref-32)
+  (:long sys:signed-sap-ref-32)
+  (:unsigned-long sys:sap-ref-32)
+  (:long-long sys:signed-sap-ref-64)
+  (:unsigned-long-long sys:sap-ref-64)
+  (:float sys:sap-ref-single)
+  (:double sys:sap-ref-double)
+  (:pointer sys:sap-ref-sap))
+
+;;;# Calling Foreign Functions
+
+(defun convert-foreign-type (type-keyword)
+  "Convert a CFFI type keyword to an ALIEN type."
+  (ecase type-keyword
+    (:char               'char)
+    (:unsigned-char      'unsigned-char)
+    (:short              'short)
+    (:unsigned-short     'unsigned-short)
+    (:int                'int)
+    (:unsigned-int       'unsigned-int)
+    (:long               'long)
+    (:unsigned-long      'unsigned-long)
+    (:long-long          '(signed 64))
+    (:unsigned-long-long '(unsigned 64))
+    (:float              'single-float)
+    (:double             'double-float)
+    (:pointer            'system-area-pointer)
+    (:void               'void)))
+
+(defun %foreign-type-size (type-keyword)
+  "Return the size in bytes of a foreign type."
+  (/ (alien-internals:alien-type-bits
+      (alien-internals:parse-alien-type
+       (convert-foreign-type type-keyword))) 8))
+
+(defun %foreign-type-alignment (type-keyword)
+  "Return the alignment in bytes of a foreign type."
+  (/ (alien-internals:alien-type-alignment
+      (alien-internals:parse-alien-type
+       (convert-foreign-type type-keyword))) 8))
+
+(defun foreign-funcall-type-and-args (args)
+  "Return an ALIEN function type for ARGS."
+  (let ((return-type nil))
+    (loop for (type arg) on args by #'cddr
+          if arg collect (convert-foreign-type type) into types
+          and collect arg into fargs
+          else do (setf return-type (convert-foreign-type type))
+          finally (return (values types fargs return-type)))))
+
+(defmacro %%foreign-funcall (name types fargs rettype)
+  "Internal guts of %FOREIGN-FUNCALL."
+  `(alien-funcall
+    (extern-alien ,name (function ,rettype , at types))
+    , at fargs))
+
+(defmacro %foreign-funcall (name &rest args)
+  "Perform a foreign function call, document it more later."
+  (multiple-value-bind (types fargs rettype)
+      (foreign-funcall-type-and-args args)
+    `(%%foreign-funcall ,name ,types ,fargs ,rettype)))
+
+(defmacro %foreign-funcall-pointer (ptr &rest args)
+  "Funcall a pointer to a foreign function."
+  (multiple-value-bind (types fargs rettype)
+      (foreign-funcall-type-and-args args)
+    (with-unique-names (function)
+      `(with-alien ((,function (* (function ,rettype , at types)) ,ptr))
+         (alien-funcall ,function , at fargs)))))
+
+;;;# Callbacks
+
+(defvar *callbacks* (make-hash-table))
+
+;;; Create a package to contain the symbols for callback functions.  We
+;;; want to redefine callbacks with the same symbol so the internal data
+;;; structures are reused.
+(defpackage #:cffi-callbacks
+  (:use))
+
+;;; Intern a symbol in the CFFI-CALLBACKS package used to name the internal
+;;; callback for NAME.
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun intern-callback (name)
+    (intern (format nil "~A::~A" (package-name (symbol-package name))
+                    (symbol-name name))
+            '#:cffi-callbacks)))
+
+(defmacro %defcallback (name rettype arg-names arg-types &body body)
+  (let ((cb-name (intern-callback name)))
+    `(progn
+       (def-callback ,cb-name
+           (,(convert-foreign-type rettype)
+             ,@(mapcar (lambda (sym type)
+                         (list sym (convert-foreign-type type)))
+                       arg-names arg-types))
+         , at body)
+       (setf (gethash ',name *callbacks*) (callback ,cb-name)))))
+
+(defun %callback (name)
+  (multiple-value-bind (pointer winp)
+      (gethash name *callbacks*)
+    (unless winp
+      (error "Undefined callback: ~S" name))
+    pointer))
+
+;;;# Loading and Closing Foreign Libraries
+
+;;; Work-around for compiling ffi code without loading the
+;;; respective library at compile-time.
+(setf c::top-level-lambda-max 0)
+
+(defun %load-foreign-library (name)
+  "Load the foreign library NAME."
+  (sys::load-object-file name))
+
+;;; XXX: doesn't work on Darwin; does not check for errors. I suppose we'd
+;;; want something like SBCL's dlclose-or-lose in foreign-load.lisp:66
+(defun %close-foreign-library (name)
+  "Closes the foreign library NAME."
+  (let ((lib (find name sys::*global-table* :key #'cdr :test #'string=)))
+    (sys::dlclose (car lib))
+    (setf (car lib) (sys:int-sap 0))))
+
+;;;# Foreign Globals
+
+(defun foreign-symbol-pointer (name)
+  "Returns a pointer to a foreign symbol NAME."
+  (let ((address (sys:alternate-get-global-address
+                  (vm:extern-alien-name name))))
+    (if (zerop address)
+        nil
+        (sys:int-sap address))))

Added: branches/xml-class-rework/thirdparty/cffi/src/cffi-corman.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/src/cffi-corman.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/src/cffi-corman.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,321 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; cffi-corman.lisp --- CFFI-SYS implementation for Corman Lisp.
+;;;
+;;; Copyright (C) 2005, Luis Oliveira  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+;;;# Administrivia
+
+(defpackage #:cffi-sys
+  (:use #:common-lisp #:c-types #:cffi-utils)
+  (:export
+   #:canonicalize-symbol-name-case
+   #:pointerp
+   #:pointer-eq
+   #:null-pointer
+   #:null-pointer-p
+   #:inc-pointer
+   #:make-pointer
+   #:pointer-address
+   #:%foreign-alloc
+   #:foreign-free
+   #:with-foreign-pointer
+   #:%foreign-funcall
+   #:%foreign-type-alignment
+   #:%foreign-type-size
+   #:%load-foreign-library
+   #:%mem-ref
+   #:%mem-set
+   ;#:make-shareable-byte-vector
+   ;#:with-pointer-to-vector-data
+   #:foreign-symbol-pointer
+   #:defcfun-helper-forms
+   #:%defcallback
+   #:%callback))
+
+(in-package #:cffi-sys)
+
+;;;# Features
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (mapc (lambda (feature) (pushnew feature *features*))
+        '(;; Backend mis-features.
+          cffi-features:no-long-long
+          cffi-features:no-foreign-funcall
+          ;; OS/CPU features.
+          cffi-features:windows
+          cffi-features:x86
+          )))
+
+;;; Symbol case.
+
+(defun canonicalize-symbol-name-case (name)
+  (declare (string name))
+  (string-upcase name))
+
+;;;# Basic Pointer Operations
+
+(defun pointerp (ptr)
+  "Return true if PTR is a foreign pointer."
+  (cpointerp ptr))
+
+(defun pointer-eq (ptr1 ptr2)
+  "Return true if PTR1 and PTR2 point to the same address."
+  (cpointer= ptr1 ptr2))
+
+(defun null-pointer ()
+  "Return a null pointer."
+  (create-foreign-ptr))
+
+(defun null-pointer-p (ptr)
+  "Return true if PTR is a null pointer."
+  (cpointer-null ptr))
+
+(defun inc-pointer (ptr offset)
+  "Return a pointer pointing OFFSET bytes past PTR."
+  (let ((new-ptr (create-foreign-ptr)))
+    (setf (cpointer-value new-ptr)
+          (+ (cpointer-value ptr) offset))
+    new-ptr))
+
+(defun make-pointer (address)
+  "Return a pointer pointing to ADDRESS."
+  (int-to-foreign-ptr address))
+
+(defun pointer-address (ptr)
+  "Return the address pointed to by PTR."
+  (foreign-ptr-to-int ptr))
+
+;;;# Allocation
+;;;
+;;; Functions and macros for allocating foreign memory on the stack
+;;; and on the heap.  The main CFFI package defines macros that wrap
+;;; FOREIGN-ALLOC and FOREIGN-FREE in UNWIND-PROTECT for the common usage
+;;; when the memory has dynamic extent.
+
+(defun %foreign-alloc (size)
+  "Allocate SIZE bytes on the heap and return a pointer."
+  (malloc size))
+
+(defun foreign-free (ptr)
+  "Free a PTR allocated by FOREIGN-ALLOC."
+  (free ptr))
+
+(defmacro with-foreign-pointer ((var size &optional size-var) &body body)
+  "Bind VAR to SIZE bytes of foreign memory during BODY.  The
+pointer in VAR is invalid beyond the dynamic extent of BODY, and
+may be stack-allocated if supported by the implementation.  If
+SIZE-VAR is supplied, it will be bound to SIZE during BODY."
+  (unless size-var
+    (setf size-var (gensym "SIZE")))
+  `(let* ((,size-var ,size)
+          (,var (malloc ,size-var)))
+     (unwind-protect
+          (progn , at body)
+       (free ,var))))
+     
+;;;# Shareable Vectors
+;;;
+;;; This interface is very experimental.  WITH-POINTER-TO-VECTOR-DATA
+;;; should be defined to perform a copy-in/copy-out if the Lisp
+;;; implementation can't do this.
+
+;(defun make-shareable-byte-vector (size)
+;  "Create a Lisp vector of SIZE bytes can passed to
+;WITH-POINTER-TO-VECTOR-DATA."
+;  (make-array size :element-type '(unsigned-byte 8)))
+;
+;(defmacro with-pointer-to-vector-data ((ptr-var vector) &body body)
+;  "Bind PTR-VAR to a foreign pointer to the data in VECTOR."
+;  `(sb-sys:without-gcing
+;     (let ((,ptr-var (sb-sys:vector-sap ,vector)))
+;       , at body)))
+
+;;;# Dereferencing
+
+;; According to the docs, Corman's C Function Definition Parser
+;; converts int to long, so we'll assume that.
+(defun convert-foreign-type (type-keyword)
+  "Convert a CFFI type keyword to a CormanCL type."
+  (ecase type-keyword
+    (:char             :char)
+    (:unsigned-char    :unsigned-char)
+    (:short            :short)
+    (:unsigned-short   :unsigned-short)
+    (:int              :long)
+    (:unsigned-int     :unsigned-long)
+    (:long             :long)
+    (:unsigned-long    :unsigned-long)
+    (:float            :single-float)
+    (:double           :double-float)
+    (:pointer          :handle)
+    (:void             :void)))
+
+(defun %mem-ref (ptr type &optional (offset 0))
+  "Dereference an object of TYPE at OFFSET bytes from PTR."
+  (unless (eql offset 0)
+    (setq ptr (inc-pointer ptr offset)))
+  (ecase type
+    (:char             (cref (:char *) ptr 0))
+    (:unsigned-char    (cref (:unsigned-char *) ptr 0))
+    (:short            (cref (:short *) ptr 0))
+    (:unsigned-short   (cref (:unsigned-short *) ptr 0))
+    (:int              (cref (:long *) ptr 0))
+    (:unsigned-int     (cref (:unsigned-long *) ptr 0))
+    (:long             (cref (:long *) ptr 0))
+    (:unsigned-long    (cref (:unsigned-long *) ptr 0))
+    (:float            (cref (:single-float *) ptr 0))
+    (:double           (cref (:double-float *) ptr 0))
+    (:pointer          (cref (:handle *) ptr 0))))
+
+;(define-compiler-macro %mem-ref (&whole form ptr type &optional (offset 0))
+;  (if (constantp type)
+;      `(cref (,(convert-foreign-type type) *) ,ptr ,offset)
+;      form))
+
+(defun %mem-set (value ptr type &optional (offset 0))
+  "Set the object of TYPE at OFFSET bytes from PTR."
+  (unless (eql offset 0)
+    (setq ptr (inc-pointer ptr offset)))
+  (ecase type
+    (:char             (setf (cref (:char *) ptr 0) value))
+    (:unsigned-char    (setf (cref (:unsigned-char *) ptr 0) value))
+    (:short            (setf (cref (:short *) ptr 0) value))
+    (:unsigned-short   (setf (cref (:unsigned-short *) ptr 0) value))
+    (:int              (setf (cref (:long *) ptr 0) value))
+    (:unsigned-int     (setf (cref (:unsigned-long *) ptr 0) value))
+    (:long             (setf (cref (:long *) ptr 0) value))
+    (:unsigned-long    (setf (cref (:unsigned-long *) ptr 0) value))
+    (:float            (setf (cref (:single-float *) ptr 0) value))
+    (:double           (setf (cref (:double-float *) ptr 0) value))
+    (:pointer          (setf (cref (:handle *) ptr 0) value))))
+
+;;;# Calling Foreign Functions
+
+(defun %foreign-type-size (type-keyword)
+  "Return the size in bytes of a foreign type."
+  (sizeof (convert-foreign-type type-keyword)))
+
+;; Couldn't find anything in sys/ffi.lisp and the C declaration parser
+;; doesn't seem to care about alignment so we'll assume that it's the
+;; same as its size.
+(defun %foreign-type-alignment (type-keyword)
+  (sizeof (convert-foreign-type type-keyword)))
+
+(defun find-dll-containing-function (name)
+  "Searches for NAME in the loaded DLLs. If found, returns
+the DLL's name (a string), else returns NIL."
+  (dolist (dll ct::*dlls-loaded*)
+    (when (ignore-errors
+            (ct::get-dll-proc-address name (ct::dll-record-handle dll)))
+      (return (ct::dll-record-name dll)))))
+
+;; This won't work at all...
+;(defmacro %foreign-funcall (name &rest args)
+;  (let ((sym (gensym)))
+;    `(let (,sym)
+;       (ct::install-dll-function ,(find-dll-containing-function name)
+;                                 ,name ,sym)
+;       (funcall ,sym ,@(loop for (type arg) on args by #'cddr
+;                             if arg collect arg)))))
+
+;; It *might* be possible to implement by copying
+;; most of the code from Corman's DEFUN-DLL.
+(defmacro %foreign-funcall (name &rest args)
+  "Call a foreign function NAME passing arguments ARGS."
+  `(format t "~&;; Calling ~A with args ~S.~%" ,name ',args))
+
+(defun defcfun-helper-forms (name lisp-name rettype args types)
+  "Return 2 values for DEFCFUN. A prelude form and a caller form."
+  (let ((ff-name (intern (format nil "%cffi-foreign-function/~A" lisp-name)))
+        ;; XXX This will only work if the dll is already loaded, fix this.
+        (dll (find-dll-containing-function name)))
+    (values
+     `(defun-dll ,ff-name
+          ,(mapcar (lambda (type)
+                     (list (gensym) (convert-foreign-type type)))
+                   types)
+        :return-type ,(convert-foreign-type rettype)
+        :library-name ,dll
+        :entry-name ,name
+        ;; we want also :pascal linkage type to access
+        ;; the win32 api for instance..
+        :linkage-type :c)
+     `(,ff-name , at args))))
+
+;;;# Callbacks
+
+;; defun-c-callback vs. defun-direct-c-callback?
+;; same issue as Allegro, no return type declaration, should we coerce?
+(defmacro %defcallback (name rettype arg-names arg-types body-form)
+  (declare (ignore rettype))
+  (with-unique-names (cb-sym)
+    `(progn
+       (defun-c-callback ,cb-sym
+           ,(mapcar (lambda (sym type) (list sym (convert-foreign-type type)))
+                            arg-names arg-types)
+         ,body-form)
+       (setf (get ',name 'callback-ptr)
+             (get-callback-procinst ',cb-sym)))))
+
+;;; Just continue to use the plist for now even though this really
+;;; should use a *CALLBACKS* hash table and not define the callbacks
+;;; as gensyms.  Someone with access to Corman should update this.
+(defun %callback (name)
+  (get name 'callback-ptr))
+
+;;;# Loading Foreign Libraries
+
+(defun %load-foreign-library (name)
+  "Load the foreign library NAME."
+  (ct::get-dll-record name))
+
+(defun %close-foreign-library (name)
+  "Close the foreign library NAME."
+  (error "Not implemented."))
+
+;;;# Foreign Globals
+
+;; FFI to GetProcAddress from the Win32 API.
+;; "The GetProcAddress function retrieves the address of an exported
+;; function or variable from the specified dynamic-link library (DLL)."
+(defun-dll get-proc-address
+    ((module HMODULE)
+     (name LPCSTR))
+  :return-type FARPROC
+  :library-name "Kernel32.dll"
+  :entry-name "GetProcAddress"
+  :linkage-type :pascal)
+
+(defun foreign-symbol-pointer (name)
+  "Returns a pointer to a foreign symbol NAME."
+  (let ((str (lisp-string-to-c-string name)))
+    (unwind-protect
+         (dolist (dll ct::*dlls-loaded*)
+           (let ((ptr (get-proc-address
+                       (int-to-foreign-ptr (ct::dll-record-handle dll))
+                       str)))
+             (when (not (cpointer-null ptr))
+               (return ptr))))
+      (free str))))

Added: branches/xml-class-rework/thirdparty/cffi/src/cffi-ecl.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/src/cffi-ecl.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/src/cffi-ecl.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,266 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; cffi-ecl.lisp --- ECL backend for CFFI.
+;;;
+;;; Copyright (C) 2005, James Bielman  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+;;;# Administrivia
+
+(defpackage #:cffi-sys
+  (:use #:common-lisp #:cffi-utils)
+  (:export
+   #:canonicalize-symbol-name-case
+   #:pointerp
+   #:pointer-eq
+   #:%foreign-alloc
+   #:foreign-free
+   #:with-foreign-pointer
+   #:null-pointer
+   #:null-pointer-p
+   #:inc-pointer
+   #:make-pointer
+   #:pointer-address
+   #:%mem-ref
+   #:%mem-set
+   #:%foreign-funcall
+   #:%foreign-type-alignment
+   #:%foreign-type-size
+   #:%load-foreign-library
+   #:make-shareable-byte-vector
+   #:with-pointer-to-vector-data
+   #:%defcallback
+   #:%callback
+   #:foreign-symbol-pointer))
+
+(in-package #:cffi-sys)
+
+;;;# Features
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (mapc (lambda (feature) (pushnew feature *features*))
+        '(;; Backend mis-features.
+          cffi-features:no-long-long
+          ;; OS/CPU features.
+          #+darwin       cffi-features:darwin 
+          #+unix         cffi-features:unix
+          #+win32        cffi-features:windows
+          ;; XXX: figure out a way to get a X86 feature
+          ;;#+athlon       cffi-features:x86
+          #+powerpc7450  cffi-features:ppc32 
+          )))
+
+;;; Symbol case.
+
+(defun canonicalize-symbol-name-case (name)
+  (declare (string name))
+  (string-upcase name))
+
+;;;# Allocation
+
+(defun %foreign-alloc (size)
+  "Allocate SIZE bytes of foreign-addressable memory."
+  (si:allocate-foreign-data :void size))
+
+(defun foreign-free (ptr)
+  "Free a pointer PTR allocated by FOREIGN-ALLOC."
+  (si:free-foreign-data ptr))
+
+(defmacro with-foreign-pointer ((var size &optional size-var) &body body)
+  "Bind VAR to SIZE bytes of foreign memory during BODY.  The
+pointer in VAR is invalid beyond the dynamic extent of BODY, and
+may be stack-allocated if supported by the implementation.  If
+SIZE-VAR is supplied, it will be bound to SIZE during BODY."
+  (unless size-var
+    (setf size-var (gensym "SIZE")))
+  `(let* ((,size-var ,size)
+          (,var (%foreign-alloc ,size-var)))
+     (unwind-protect
+          (progn , at body)
+       (foreign-free ,var))))
+
+;;;# Misc. Pointer Operations
+
+(defun null-pointer ()
+  "Construct and return a null pointer."
+  (si:allocate-foreign-data :void 0))
+
+(defun null-pointer-p (ptr)
+  "Return true if PTR is a null pointer."
+  (si:null-pointer-p ptr))
+
+(defun inc-pointer (ptr offset)
+  "Return a pointer OFFSET bytes past PTR."
+  (ffi:make-pointer (+ (ffi:pointer-address ptr) offset) :void))
+
+(defun pointerp (ptr)
+  "Return true if PTR is a foreign pointer."
+  (typep ptr 'si:foreign-data))
+
+(defun pointer-eq (ptr1 ptr2)
+  "Return true if PTR1 and PTR2 point to the same address."
+  (= (ffi:pointer-address ptr1) (ffi:pointer-address ptr2)))
+
+(defun make-pointer (address)
+  "Return a pointer pointing to ADDRESS."
+  (ffi:make-pointer address :void))
+
+(defun pointer-address (ptr)
+  "Return the address pointed to by PTR."
+  (ffi:pointer-address ptr))
+
+;;;# Dereferencing
+
+(defun %mem-ref (ptr type &optional (offset 0))
+  "Dereference an object of TYPE at OFFSET bytes from PTR."
+  (let* ((type (convert-foreign-type type))
+         (type-size (ffi:size-of-foreign-type type)))
+    (si:foreign-data-ref-elt
+     (si:foreign-data-recast ptr (+ offset type-size) :void) offset type)))
+
+(defun %mem-set (value ptr type &optional (offset 0))
+  "Set an object of TYPE at OFFSET bytes from PTR."
+  (let* ((type (convert-foreign-type type))
+         (type-size (ffi:size-of-foreign-type type)))
+    (si:foreign-data-set-elt
+     (si:foreign-data-recast ptr (+ offset type-size) :void)
+     offset type value)))
+
+;;;# Type Operations
+
+(defun convert-foreign-type (type-keyword)
+  "Convert a CFFI type keyword to an ECL type keyword."
+  (ecase type-keyword
+    (:char            :byte)
+    (:unsigned-char   :unsigned-byte)
+    (:short           :short)
+    (:unsigned-short  :unsigned-short)
+    (:int             :int)
+    (:unsigned-int    :unsigned-int)
+    (:long            :long)
+    (:unsigned-long   :unsigned-long)
+    (:float           :float)
+    (:double          :double)
+    (:pointer         :pointer-void)
+    (:void            :void)))
+
+(defun %foreign-type-size (type-keyword)
+  "Return the size in bytes of a foreign type."
+  (nth-value 0 (ffi:size-of-foreign-type
+                (convert-foreign-type type-keyword))))
+
+(defun %foreign-type-alignment (type-keyword)
+  "Return the alignment in bytes of a foreign type."
+  (nth-value 1 (ffi:size-of-foreign-type
+                (convert-foreign-type type-keyword))))
+
+;;;# Calling Foreign Functions
+
+(defun produce-function-call (c-name nargs)
+  (format nil "~a(~a)" c-name
+          (subseq "#0,#1,#2,#3,#4,#5,#6,#7,#8,#9,#a,#b,#c,#d,#e,#f,#g,#h,#i,#j,#k,#l,#m,#n,#o,#p,#q,#r,#s,#t,#u,#v,#w,#x,#y,#z"
+                  0 (max 0 (1- (* nargs 3))))))
+
+#-dfii
+(defun foreign-function-inline-form (name arg-types arg-values return-type)
+  "Generate a C-INLINE form for a foreign function call."
+  `(ffi:c-inline
+    ,arg-values ,arg-types ,return-type
+    ,(produce-function-call name (length arg-values))
+    :one-liner t :side-effects t))
+
+#+dffi
+(defun foreign-function-dynamic-form (name arg-types arg-values return-type)
+  "Generate a dynamic FFI form for a foreign function call."
+  `(si:call-cfun (si:find-foreign-symbol ,name :default :pointer-void 0)
+                 ,return-type (list , at arg-types) (list , at arg-values)))
+
+(defun foreign-funcall-parse-args (args)
+  "Return three values, lists of arg types, values, and result type."
+  (let ((return-type :void))
+    (loop for (type arg) on args by #'cddr
+          if arg collect (convert-foreign-type type) into types
+          and collect arg into values
+          else do (setf return-type (convert-foreign-type type))
+          finally (return (values types values return-type)))))
+
+(defmacro %foreign-funcall (name &rest args)
+  "Call a foreign function."
+  (multiple-value-bind (types values return-type)
+      (foreign-funcall-parse-args args)
+    #-dffi (foreign-function-inline-form name types values return-type)
+    #+dffi (foreign-function-dynamic-form name types values return-type)))
+
+#+dffi
+(defmacro %foreign-funcall-pointer (ptr &rest args)
+  "Funcall a pointer to a foreign function."
+  (multiple-value-bind (types values return-type)
+      (foreign-funcall-parse-args args)
+    `(si:call-cfun ,ptr ,return-type (list , at arg-types) (list , at arg-values))))
+
+;;;# Foreign Libraries
+
+(defun %load-foreign-library (name)
+  "Load a foreign library from NAME."
+  #-dffi (error "LOAD-FOREIGN-LIBRARY requires ECL's DFFI support. Use ~
+                 FFI:LOAD-FOREIGN-LIBRARY with a constant argument instead.")
+  #+dffi (ffi:load-foreign-library name))
+
+;;;# Callbacks
+
+;;; Create a package to contain the symbols for callback functions.
+;;; We want to redefine callbacks with the same symbol so the internal
+;;; data structures are reused.
+(defpackage #:cffi-callbacks
+  (:use))
+
+;;; Intern a symbol in the CFFI-CALLBACKS package used to name the
+;;; internal callback for NAME.
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun intern-callback (name)
+    (intern (format nil "~A::~A" (package-name (symbol-package name))
+                    (symbol-name name))
+            '#:cffi-callbacks)))
+
+(defmacro %defcallback (name rettype arg-names arg-types &body body)
+  (let ((cb-name (intern-callback name)))
+    `(progn
+       (ffi:defcallback (,cb-name :cdecl)
+           ,(convert-foreign-type rettype)
+           ,(mapcar #'list arg-names
+                    (mapcar #'convert-foreign-type arg-types))
+         , at body)
+       (setf (gethash ',name *callbacks*) ',cb-name))))
+
+(defun %callback (name)
+  (multiple-value-bind (symbol winp)
+      (gethash name *callbacks*)
+    (unless winp
+      (error "Undefined callback: ~S" name))
+    (ffi:callback name)))
+
+;;;# Foreign Globals
+
+(defun foreign-symbol-pointer (name kind)
+  "Returns a pointer to a foreign symbol NAME."
+  (si:find-foreign-symbol name :default :pointer-void 0))

Added: branches/xml-class-rework/thirdparty/cffi/src/cffi-gcl.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/src/cffi-gcl.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/src/cffi-gcl.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,313 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; cffi-gcl.lisp --- CFFI-SYS implementation for GNU Common Lisp.
+;;;
+;;; Copyright (C) 2005, Luis Oliveira  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+;;; GCL specific notes:
+;;;
+;;; On ELF systems, a library can be loaded with the help of this:
+;;;   http://www.copyleft.de/lisp/gcl-elf-loader.html
+;;;
+;;; Another way is to link the library when creating a new image:
+;;;   (compiler::link nil "new_image" "" "-lfoo")
+;;;
+;;; As GCL's FFI is not dynamic, CFFI declarations will only work
+;;; after compiled and loaded.
+
+;;; *** this port is broken ***
+;;; gcl doesn't compile the rest of CFFI anyway..
+
+;;;# Administrivia
+
+(defpackage #:cffi-sys
+  (:use #:common-lisp)
+  (:export
+   #:canonicalize-symbol-name-case
+   #:pointerp
+   #:%foreign-alloc
+   #:foreign-free
+   #:with-foreign-ptr
+   #:null-ptr
+   #:null-ptr-p
+   #:inc-ptr
+   #:%mem-ref
+   #:%mem-set
+   #:%foreign-funcall
+   #:%foreign-type-alignment
+   #:%foreign-type-size
+   #:%load-foreign-library
+   ;#:make-shareable-byte-vector
+   ;#:with-pointer-to-vector-data
+   #:foreign-var-ptr
+   #:make-callback))
+ 
+(in-package #:cffi-sys)
+
+;;;# Mis-*features*
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (pushnew :cffi/no-foreign-funcall *features*))
+
+;;; Symbol case.
+
+(defun canonicalize-symbol-name-case (name)
+  (declare (string name))
+  (string-upcase name))
+
+;;;# Allocation
+;;;
+;;; Functions and macros for allocating foreign memory on the stack
+;;; and on the heap.  The main CFFI package defines macros that wrap
+;;; FOREIGN-ALLOC and FOREIGN-FREE in UNWIND-PROTECT for the common
+;;; usage when the memory has dynamic extent.
+
+(defentry %foreign-alloc (int) (int "malloc"))
+
+;(defun foreign-alloc (size)
+;  "Allocate SIZE bytes on the heap and return a pointer."
+;  (%foreign-alloc size))
+
+(defentry foreign-free (int) (void "free"))
+
+;(defun foreign-free (ptr)
+;  "Free a PTR allocated by FOREIGN-ALLOC."
+;  (%free ptr))
+
+(defmacro with-foreign-ptr ((var size &optional size-var) &body body)
+  "Bind VAR to SIZE bytes of foreign memory during BODY.  The
+pointer in VAR is invalid beyond the dynamic extent of BODY, and
+may be stack-allocated if supported by the implementation.  If
+SIZE-VAR is supplied, it will be bound to SIZE during BODY."
+  (unless size-var
+    (setf size-var (gensym "SIZE")))
+  `(let* ((,size-var ,size)
+          (,var (foreign-alloc ,size-var)))
+     (unwind-protect
+          (progn , at body)
+       (foreign-free ,var))))
+
+;;;# Misc. Pointer Operations
+
+(defun pointerp (ptr)
+  "Return true if PTR is a foreign pointer."
+  (integerp ptr))
+
+(defun null-ptr ()
+  "Construct and return a null pointer."
+  0)
+
+(defun null-ptr-p (ptr)
+  "Return true if PTR is a null pointer."
+  (= ptr 0))
+
+(defun inc-ptr (ptr offset)
+  "Return a pointer OFFSET bytes past PTR."
+  (+ ptr offset))
+
+;;;# Shareable Vectors
+;;;
+;;; This interface is very experimental.  WITH-POINTER-TO-VECTOR-DATA
+;;; should be defined to perform a copy-in/copy-out if the Lisp
+;;; implementation can't do this.
+
+;(defun make-shareable-byte-vector (size)
+;  "Create a Lisp vector of SIZE bytes that can passed to
+;WITH-POINTER-TO-VECTOR-DATA."
+;  (make-array size :element-type '(unsigned-byte 8)))
+
+;(defmacro with-pointer-to-vector-data ((ptr-var vector) &body body)
+;  "Bind PTR-VAR to a foreign pointer to the data in VECTOR."
+;  `(ccl:with-pointer-to-ivector (,ptr-var ,vector)
+;     , at body))
+
+;;;# Dereferencing
+
+(defmacro define-mem-ref/set (type gcl-type &optional c-name)
+  (unless c-name
+    (setq c-name (substitute #\_ #\Space type)))
+  (let ((ref-fn (concatenate 'string "ref_" c-name))
+        (set-fn (concatenate 'string "set_" c-name)))
+    `(progn
+       ;; ref
+       (defcfun ,(format nil "~A ~A(~A *ptr)" type ref-fn type)
+           0 "return *ptr;")
+       (defentry ,(intern (string-upcase (substitute #\- #\_ ref-fn)))
+           (int) (,gcl-type ,ref-fn))
+       ;; set
+       (defcfun ,(format nil "void ~A(~A *ptr, ~A value)" set-fn type type)
+           0 "*ptr = value;")
+       (defentry ,(intern (string-upcase (substitute #\- #\_ set-fn)))
+           (int ,gcl-type) (void ,set-fn)))))
+
+(define-mem-ref/set "char" char)
+(define-mem-ref/set "unsigned char" char)
+(define-mem-ref/set "short" int)
+(define-mem-ref/set "unsigned short" int)
+(define-mem-ref/set "int" int)
+(define-mem-ref/set "unsigned int" int)
+(define-mem-ref/set "long" int)
+(define-mem-ref/set "unsigned long" int)
+(define-mem-ref/set "float" float)
+(define-mem-ref/set "double" double)
+(define-mem-ref/set "void *" int "ptr")
+
+(defun %mem-ref (ptr type &optional (offset 0))
+  "Dereference an object of TYPE at OFFSET bytes from PTR."
+  (unless (zerop offset)
+    (incf ptr offset))
+  (ecase type
+    (:char            (ref-char ptr))
+    (:unsigned-char   (ref-unsigned-char ptr))
+    (:short           (ref-short ptr))
+    (:unsigned-short  (ref-unsigned-short ptr))
+    (:int             (ref-int ptr))
+    (:unsigned-int    (ref-unsigned-int ptr))
+    (:long            (ref-long ptr))
+    (:unsigned-long   (ref-unsigned-long ptr))
+    (:float           (ref-float ptr))
+    (:double          (ref-double ptr))
+    (:pointer         (ref-ptr ptr))))
+
+(defun %mem-set (value ptr type &optional (offset 0))
+  (unless (zerop offset)
+    (incf ptr offset))
+  (ecase type
+    (:char            (set-char ptr value))
+    (:unsigned-char   (set-unsigned-char ptr value))
+    (:short           (set-short ptr value))
+    (:unsigned-short  (set-unsigned-short ptr value))
+    (:int             (set-int ptr value))
+    (:unsigned-int    (set-unsigned-int ptr value))
+    (:long            (set-long ptr value))
+    (:unsigned-long   (set-unsigned-long ptr value))
+    (:float           (set-float ptr value))
+    (:double          (set-double ptr value))
+    (:pointer         (set-ptr ptr value)))
+  value)
+
+;;;# Calling Foreign Functions
+
+;; TODO: figure out if these type conversions make any sense...
+(defun convert-foreign-type (type-keyword)
+  "Convert a CFFI type keyword to a GCL type."
+  (ecase type-keyword
+    (:char            'char)
+    (:unsigned-char   'char)
+    (:short           'int)
+    (:unsigned-short  'int)
+    (:int             'int)
+    (:unsigned-int    'int)
+    (:long            'int)
+    (:unsigned-long   'int)
+    (:float           'float)
+    (:double          'double)
+    (:pointer         'int)
+    (:void            'void)))
+
+(defparameter +cffi-types+
+  '(:char :unsigned-char :short :unsigned-short :int :unsigned-int
+    :long :unsigned-long :float :double :pointer))
+
+(defcfun "int size_of(int type)" 0
+  "switch (type) {
+     case 0:  return sizeof(char);
+     case 1:  return sizeof(unsigned char);
+     case 2:  return sizeof(short);
+     case 3:  return sizeof(unsigned short);
+     case 4:  return sizeof(int);
+     case 5:  return sizeof(unsigned int);
+     case 6:  return sizeof(long);
+     case 7:  return sizeof(unsigned long);
+     case 8:  return sizeof(float);
+     case 9:  return sizeof(double);
+     case 10: return sizeof(void *);
+     default: return -1;
+   }")
+
+(defentry size-of (int) (int "size_of"))
+
+;; TODO: all this is doable inside the defcfun; figure that out..
+(defun %foreign-type-size (type-keyword)
+  "Return the size in bytes of a foreign type."
+  (size-of (position type-keyword +cffi-types+)))
+
+(defcfun "int align_of(int type)" 0
+  "switch (type) {
+     case 0:  return __alignof__(char);
+     case 1:  return __alignof__(unsigned char);
+     case 2:  return __alignof__(short);
+     case 3:  return __alignof__(unsigned short);
+     case 4:  return __alignof__(int);
+     case 5:  return __alignof__(unsigned int);
+     case 6:  return __alignof__(long);
+     case 7:  return __alignof__(unsigned long);
+     case 8:  return __alignof__(float);
+     case 9:  return __alignof__(double);
+     case 10: return __alignof__(void *);
+     default: return -1;
+   }")
+
+(defentry align-of (int) (int "align_of"))
+
+;; TODO: like %foreign-type-size
+(defun %foreign-type-alignment (type-keyword)
+  "Return the alignment in bytes of a foreign type."
+  (align-of (position type-keyword +cffi-types+)))
+
+#+ignore
+(defun convert-external-name (name)
+  "Add an underscore to NAME if necessary for the ABI."
+  #+darwinppc-target (concatenate 'string "_" name)
+  #-darwinppc-target name)
+
+(defmacro %foreign-funcall (function-name &rest args)
+  "Perform a foreign function all, document it more later."
+  `(format t "~&;; Calling ~A with args ~S.~%" ,name ',args))
+
+(defun defcfun-helper-forms (name rettype args types)
+  "Return 2 values for DEFCFUN. A prelude form and a caller form."
+  (let ((ff-name (intern (format nil "%foreign-function/TildeA:~A" name))))
+    (values
+     `(defentry ,ff-name ,(mapcar #'convert-foreign-type types)
+        (,(convert-foreign-type rettype) ,name))
+     `(,ff-name , at args))))
+    
+;;;# Callbacks
+
+;;; XXX unimplemented
+(defmacro make-callback (name rettype arg-names arg-types body-form)
+  0)
+
+;;;# Loading Foreign Libraries
+
+(defun %load-foreign-library (name)
+  "_Won't_ load the foreign library NAME."
+  (declare (ignore name)))
+
+;;;# Foreign Globals
+
+;;; XXX unimplemented
+(defmacro foreign-var-ptr (name)
+  "Return a pointer pointing to the foreign symbol NAME."
+  0)

Added: branches/xml-class-rework/thirdparty/cffi/src/cffi-lispworks.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/src/cffi-lispworks.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/src/cffi-lispworks.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,404 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; cffi-lispworks.lisp --- Lispworks CFFI-SYS implementation.
+;;;
+;;; Copyright (C) 2005, James Bielman  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+;;;# Administrivia
+
+(defpackage #:cffi-sys
+  (:use #:cl #:cffi-utils)
+  (:export
+   #:canonicalize-symbol-name-case
+   #:pointerp
+   #:pointer-eq
+   #:null-pointer
+   #:null-pointer-p
+   #:inc-pointer
+   #:make-pointer
+   #:pointer-address
+   #:%foreign-alloc
+   #:foreign-free
+   #:with-foreign-pointer
+   #:%foreign-funcall
+   #:%foreign-funcall-pointer
+   #:%foreign-type-alignment
+   #:%foreign-type-size
+   #:%load-foreign-library
+   #:%close-foreign-library
+   #:%mem-ref
+   #:%mem-set
+   #:make-shareable-byte-vector
+   #:with-pointer-to-vector-data
+   #:foreign-symbol-pointer
+   #:defcfun-helper-forms
+   #:%defcallback
+   #:%callback))
+
+(in-package #:cffi-sys)
+
+;;;# Features
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (mapc (lambda (feature) (pushnew feature *features*))
+        '(;; Backend mis-features.
+          cffi-features:no-long-long
+          ;; OS/CPU features.
+          #+darwin  cffi-features:darwin
+          #+unix    cffi-features:unix
+          #+win32   cffi-features:windows
+          #+harp::pc386   cffi-features:x86
+          #+harp::powerpc cffi-features:ppc32
+          )))
+
+;;; Symbol case.
+
+(defun canonicalize-symbol-name-case (name)
+  (declare (string name))
+  (string-upcase name))
+
+;;;# Basic Pointer Operations
+(defun pointerp (ptr)
+  "Return true if PTR is a foreign pointer."
+  (fli:pointerp ptr))
+
+(defun pointer-eq (ptr1 ptr2)
+  "Return true if PTR1 and PTR2 point to the same address."
+  (fli:pointer-eq ptr1 ptr2))
+
+;; We use FLI:MAKE-POINTER here instead of FLI:*NULL-POINTER* since old
+;; versions of Lispworks don't seem to have it.
+(defun null-pointer ()
+  "Return a null foreign pointer."
+  (fli:make-pointer :address 0 :type :void))
+
+(defun null-pointer-p (ptr)
+  "Return true if PTR is a null pointer."
+  (fli:null-pointer-p ptr))
+
+;; FLI:INCF-POINTER won't work on FLI pointers to :void so we
+;; increment "manually."
+(defun inc-pointer (ptr offset)
+  "Return a pointer OFFSET bytes past PTR."
+  (fli:make-pointer :type :void :address (+ (fli:pointer-address ptr) offset)))
+
+(defun make-pointer (address)
+  "Return a pointer pointing to ADDRESS."
+  (fli:make-pointer :type :void :address address))
+
+(defun pointer-address (ptr)
+  "Return the address pointed to by PTR."
+  (fli:pointer-address ptr))
+
+;;;# Allocation
+
+(defun %foreign-alloc (size)
+  "Allocate SIZE bytes of memory and return a pointer."
+  (fli:allocate-foreign-object :type :byte :nelems size))
+
+(defun foreign-free (ptr)
+  "Free a pointer PTR allocated by FOREIGN-ALLOC."
+  (fli:free-foreign-object ptr))
+
+(defmacro with-foreign-pointer ((var size &optional size-var) &body body)
+  "Bind VAR to SIZE bytes of foreign memory during BODY.  Both the
+pointer in VAR and the memory it points to have dynamic extent and may
+be stack allocated if supported by the implementation."
+  (unless size-var
+    (setf size-var (gensym "SIZE")))
+  `(fli:with-dynamic-foreign-objects ()
+     (let* ((,size-var ,size)
+            (,var (fli:alloca :type :byte :nelems ,size-var)))
+       , at body)))
+
+;;;# Shareable Vectors
+
+(defun make-shareable-byte-vector (size)
+  "Create a shareable byte vector."
+  (sys:in-static-area
+    (make-array size :element-type '(unsigned-byte 8))))
+
+(defmacro with-pointer-to-vector-data ((ptr-var vector) &body body)
+  "Bind PTR-VAR to a pointer at the data in VECTOR."
+  `(fli:with-dynamic-lisp-array-pointer (,ptr-var ,vector)
+     , at body))
+
+;;;# Dereferencing
+
+(defun convert-foreign-type (cffi-type)
+  "Convert a CFFI type keyword to an FLI type."
+  (ecase cffi-type
+    (:char            :byte)
+    (:unsigned-char   '(:unsigned :byte))
+    (:short           :short)
+    (:unsigned-short  '(:unsigned :short))
+    (:int             :int)
+    (:unsigned-int    '(:unsigned :int))
+    (:long            :long)
+    (:unsigned-long   '(:unsigned :long))
+    (:float           :float)
+    (:double          :double)
+    (:pointer         :pointer)
+    (:void            :void)))
+
+;;; Convert a CFFI type keyword to a symbol suitable for passing to
+;;; FLI:FOREIGN-TYPED-AREF.
+#+#.(cl:if (cl:find-symbol "FOREIGN-TYPED-AREF" "FLI") '(and) '(or))
+(defun convert-foreign-typed-aref-type (cffi-type)
+  (ecase cffi-type
+    ((:char :short :int :long)
+     `(signed-byte ,(* 8 (%foreign-type-size cffi-type))))
+    ((:unsigned-char :unsigned-short :unsigned-int :unsigned-long)
+     `(unsigned-byte ,(* 8 (%foreign-type-size cffi-type))))
+    (:float 'single-float)
+    (:double 'double-float)))
+
+(defun %mem-ref (ptr type &optional (offset 0))
+  "Dereference an object of type TYPE OFFSET bytes from PTR."
+  (unless (zerop offset)
+    (setf ptr (inc-pointer ptr offset)))
+  (fli:dereference ptr :type (convert-foreign-type type)))
+
+;;; Determine the most efficient way to increment PTR by OFFSET bytes
+;;; for use in a call to FLI:FOREIGN-TYPED-AREF.  Returns a form to
+;;; use as the pointer in the call and a second value to pass as the
+;;; index.  If OFFSET is constant and a multiple of the size of TYPE,
+;;; convert it to an array index, otherwise use INC-POINTER.
+#+#.(cl:if (cl:find-symbol "FOREIGN-TYPED-AREF" "FLI") '(and) '(or))
+(defun pointer-and-index (ptr type offset)
+  (if (constantp offset)
+      (let ((offset (eval offset))
+            (size (%foreign-type-size type)))
+        (multiple-value-bind (q r) (truncate offset size)
+          (if (zerop r)
+              (values ptr q)
+              (values `(inc-pointer ,ptr ,offset) 0))))
+      (values `(inc-pointer ,ptr ,offset) 0)))
+
+;;; In LispWorks versions where FLI:FOREIGN-TYPED-AREF is fbound, use
+;;; it instead of FLI:DEREFERENCE in the optimizer for %MEM-REF.
+#+#.(cl:if (cl:find-symbol "FOREIGN-TYPED-AREF" "FLI") '(and) '(or))
+(define-compiler-macro %mem-ref (&whole form ptr type &optional (off 0))
+  (if (constantp type)
+      (let ((type (eval type)))
+        (if (eql type :pointer)
+            (let ((fli-type (convert-foreign-type type))
+                  (ptr-form (if (eql off 0) ptr `(inc-pointer ,ptr ,off))))
+              `(fli:dereference ,ptr-form :type ',fli-type))
+            (let ((lisp-type (convert-foreign-typed-aref-type type)))
+              (multiple-value-bind (ptr-form index)
+                  (pointer-and-index ptr type off)
+                `(locally
+                   (declare (optimize (speed 3) (safety 0)))
+                   (fli:foreign-typed-aref ',lisp-type ,ptr-form ,index))))))
+      form))
+
+;;; Open-code the call to FLI:DEREFERENCE when TYPE is constant at
+;;; macroexpansion time, when FLI:FOREIGN-TYPED-AREF is not available.
+#-#.(cl:if (cl:find-symbol "FOREIGN-TYPED-AREF" "FLI") '(and) '(or))
+(define-compiler-macro %mem-ref (&whole form ptr type &optional (off 0))
+  (if (constantp type)
+      (let ((ptr-form (if (eql off 0) ptr `(inc-pointer ,ptr ,off)))
+            (type (convert-foreign-type (eval type))))
+        `(fli:dereference ,ptr-form :type ',type))
+      form))
+
+(defun %mem-set (value ptr type &optional (offset 0))
+  "Set the object of TYPE at OFFSET bytes from PTR."
+  (unless (zerop offset)
+    (setf ptr (inc-pointer ptr offset)))
+  (setf (fli:dereference ptr :type (convert-foreign-type type)) value))
+
+;;; In LispWorks versions where FLI:FOREIGN-TYPED-AREF is fbound, use
+;;; it instead of FLI:DEREFERENCE in the optimizer for %MEM-SET.
+#+#.(cl:if (cl:find-symbol "FOREIGN-TYPED-AREF" "FLI") '(and) '(or))
+(define-compiler-macro %mem-set (&whole form val ptr type &optional (off 0))
+  (if (constantp type)
+      (once-only (val)
+        (let ((type (eval type)))
+          (if (eql type :pointer)
+              (let ((fli-type (convert-foreign-type type))
+                    (ptr-form (if (eql off 0) ptr `(inc-pointer ,ptr ,off))))
+                `(setf (fli:dereference ,ptr-form :type ',fli-type) ,val))
+              (let ((lisp-type (convert-foreign-typed-aref-type type)))
+                (multiple-value-bind (ptr-form index)
+                    (pointer-and-index ptr type off)
+                  `(locally
+                       (declare (optimize (speed 3) (safety 0)))
+                     (setf (fli:foreign-typed-aref ',lisp-type ,ptr-form ,index) ,val)))))))
+      form))
+
+;;; Open-code the call to (SETF FLI:DEREFERENCE) when TYPE is constant
+;;; at macroexpansion time.
+#-#.(cl:if (cl:find-symbol "FOREIGN-TYPED-AREF" "FLI") '(and) '(or))
+(define-compiler-macro %mem-set (&whole form val ptr type &optional (off 0))
+  (if (constantp type)
+      (once-only (val)
+        (let ((ptr-form (if (eql off 0) ptr `(inc-pointer ,ptr ,off)))
+              (type (convert-foreign-type (eval type))))
+          `(setf (fli:dereference ,ptr-form :type ',type) ,val)))
+      form))
+
+;;;# Foreign Type Operations
+
+(defun %foreign-type-size (type)
+  "Return the size in bytes of a foreign type."
+  (fli:size-of (convert-foreign-type type)))
+
+(defun %foreign-type-alignment (type)
+  "Return the structure alignment in bytes of foreign type."
+  #+(and darwin harp::powerpc)
+  (when (eq type :double)
+    (return-from %foreign-type-alignment 8))
+  ;; Override not necessary for the remaining types...
+  (fli:align-of (convert-foreign-type type)))
+
+;;;# Calling Foreign Functions
+
+(defvar *foreign-funcallable-cache* (make-hash-table :test 'equal)
+  "Caches foreign funcallables created by %FOREIGN-FUNCALL or
+%FOREIGN-FUNCALL-POINTER.  We only need to have one per each
+signature.")
+
+(defun foreign-funcall-type-and-args (args)
+  "Returns a list of types, list of args and return type."
+  (let ((return-type :void))
+    (loop for (type arg) on args by #'cddr
+          if arg collect (convert-foreign-type type) into types
+          and collect arg into fargs
+          else do (setf return-type (convert-foreign-type type))
+          finally (return (values types fargs return-type)))))
+
+(defun create-foreign-funcallable (types rettype)
+  "Creates a foreign funcallable for the signature TYPES -> RETTYPE."
+  (format t "~&Creating foreign funcallable for signature ~S -> ~S~%"
+          types rettype)
+  ;; yes, ugly, this most likely wants to be a top-level form...
+  (let ((internal-name (gensym)))
+    (funcall
+     (compile nil
+              `(lambda ()
+                 (fli:define-foreign-funcallable ,internal-name
+                     ,(loop for type in types
+                            collect (list (gensym) type))
+                   :result-type ,rettype
+                   :language :ansi-c
+                   ;; avoid warning about cdecl not being supported on mac
+                   #-mac ,@'(:calling-convention :cdecl)))))
+    internal-name))
+
+(defun get-foreign-funcallable (types rettype)
+  "Returns a foreign funcallable for the signature TYPES -> RETTYPE -
+either from the cache or newly created."
+  (let ((signature (cons rettype types)))
+    (or (gethash signature *foreign-funcallable-cache*)
+        ;; (SETF GETHASH) is supposed to be thread-safe
+        (setf (gethash signature *foreign-funcallable-cache*)
+              (create-foreign-funcallable types rettype)))))
+
+(defmacro %%foreign-funcall (foreign-function &rest args)
+  "Does the actual work for %FOREIGN-FUNCALL-POINTER and %FOREIGN-FUNCALL.
+Checks if a foreign funcallable which fits ARGS already exists and creates
+and caches it if necessary.  Finally calls it."
+  (multiple-value-bind (types fargs rettype)
+      (foreign-funcall-type-and-args args)
+    `(funcall (load-time-value (get-foreign-funcallable ',types ',rettype))
+              ,foreign-function , at fargs)))
+
+(defmacro %foreign-funcall (name &rest args)
+  "Calls a foreign function named NAME passing arguments ARGS."
+  `(%%foreign-funcall (fli:make-pointer :symbol-name ,name) , at args))
+
+(defmacro %foreign-funcall-pointer (ptr &rest args)
+  "Calls a foreign function pointed at by PTR passing arguments ARGS."
+  `(%%foreign-funcall ,ptr , at args))
+
+(defun defcfun-helper-forms (name lisp-name rettype args types)
+  "Return 2 values for DEFCFUN. A prelude form and a caller form."
+  (let ((ff-name (intern (format nil "%cffi-foreign-function/~A"  lisp-name))))
+    (values
+     `(fli:define-foreign-function (,ff-name ,name :source)
+          ,(mapcar (lambda (ty) (list (gensym) (convert-foreign-type ty)))
+                   types)
+        :result-type ,(convert-foreign-type rettype)
+        :language :ansi-c
+        ;; avoid warning about cdecl not being supported on mac platforms
+        #-mac ,@'(:calling-convention :cdecl))
+     `(,ff-name , at args))))
+
+;;;# Callbacks
+
+(defvar *callbacks* (make-hash-table))
+
+;;; Create a package to contain the symbols for callback functions.  We
+;;; want to redefine callbacks with the same symbol so the internal data
+;;; structures are reused.
+(defpackage #:cffi-callbacks
+  (:use))
+
+;;; Intern a symbol in the CFFI-CALLBACKS package used to name the internal
+;;; callback for NAME.
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun intern-callback (name)
+    (intern (format nil "~A::~A" (package-name (symbol-package name))
+                    (symbol-name name))
+            '#:cffi-callbacks)))
+
+(defmacro %defcallback (name rettype arg-names arg-types &body body)
+  (let ((cb-name (intern-callback name)))
+    `(progn
+       (fli:define-foreign-callable
+           (,cb-name :encode :lisp
+                     :result-type ,(convert-foreign-type rettype)
+                     :calling-convention :cdecl
+                     :language :ansi-c
+                     :no-check nil)
+           ,(mapcar (lambda (sym type)
+                      (list sym (convert-foreign-type type)))
+                    arg-names arg-types)
+         , at body)
+       (setf (gethash ',name *callbacks*) ',cb-name))))
+
+(defun %callback (name)
+  (multiple-value-bind (symbol winp)
+      (gethash name *callbacks*)
+    (unless winp
+      (error "Undefined callback: ~S" name))
+    (fli:make-pointer :symbol-name symbol :module :callbacks)))
+
+;;;# Loading Foreign Libraries
+
+(defun %load-foreign-library (name)
+  "Load the foreign library NAME."
+  (fli:register-module name :connection-style :immediate))
+
+(defun %close-foreign-library (name)
+  "Close the foreign library NAME."
+  (fli:disconnect-module name :remove t))
+
+;;;# Foreign Globals
+
+(defun foreign-symbol-pointer (name)
+  "Returns a pointer to a foreign symbol NAME."
+  (prog1 (ignore-errors (fli:make-pointer :symbol-name name :type :void))))

Added: branches/xml-class-rework/thirdparty/cffi/src/cffi-openmcl.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/src/cffi-openmcl.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/src/cffi-openmcl.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,298 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; cffi-openmcl.lisp --- CFFI-SYS implementation for OpenMCL.
+;;;
+;;; Copyright (C) 2005, James Bielman  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+;;;# Administrivia
+
+(defpackage #:cffi-sys
+  (:use #:common-lisp #:ccl #:cffi-utils)
+  (:export
+   #:canonicalize-symbol-name-case
+   #:pointerp  ; ccl:pointerp
+   #:pointer-eq
+   #:%foreign-alloc
+   #:foreign-free
+   #:with-foreign-pointer
+   #:null-pointer
+   #:null-pointer-p
+   #:inc-pointer
+   #:make-pointer
+   #:pointer-address
+   #:%mem-ref
+   #:%mem-set
+   #:%foreign-funcall
+   #:%foreign-funcall-pointer
+   #:%foreign-type-alignment
+   #:%foreign-type-size
+   #:%load-foreign-library
+   #:%close-foreign-library
+   #:make-shareable-byte-vector
+   #:with-pointer-to-vector-data
+   #:foreign-symbol-pointer
+   #:%defcallback
+   #:%callback))
+ 
+(in-package #:cffi-sys)
+
+;;;# Features
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (mapc (lambda (feature) (pushnew feature *features*))
+        '(;; OS/CPU features.
+          #+darwinppc-target  cffi-features:darwin
+          #+unix              cffi-features:unix
+          #+ppc32-target      cffi-features:ppc32
+          )))
+
+;;; Symbol case.
+
+(defun canonicalize-symbol-name-case (name)
+  (declare (string name))
+  (string-upcase name))
+
+;;;# Allocation
+;;;
+;;; Functions and macros for allocating foreign memory on the stack
+;;; and on the heap.  The main CFFI package defines macros that wrap
+;;; FOREIGN-ALLOC and FOREIGN-FREE in UNWIND-PROTECT for the common
+;;; usage when the memory has dynamic extent.
+
+(defun %foreign-alloc (size)
+  "Allocate SIZE bytes on the heap and return a pointer."
+  (ccl::malloc size))
+
+(defun foreign-free (ptr)
+  "Free a PTR allocated by FOREIGN-ALLOC."
+  ;; TODO: Should we make this a dead macptr?
+  (ccl::free ptr))
+
+(defmacro with-foreign-pointer ((var size &optional size-var) &body body)
+  "Bind VAR to SIZE bytes of foreign memory during BODY.  The
+pointer in VAR is invalid beyond the dynamic extent of BODY, and
+may be stack-allocated if supported by the implementation.  If
+SIZE-VAR is supplied, it will be bound to SIZE during BODY."
+  (unless size-var
+    (setf size-var (gensym "SIZE")))
+  `(let ((,size-var ,size))
+     (%stack-block ((,var ,size-var))
+       , at body)))
+
+;;;# Misc. Pointer Operations
+
+(defun null-pointer ()
+  "Construct and return a null pointer."
+  (ccl:%null-ptr))
+
+(defun null-pointer-p (ptr)
+  "Return true if PTR is a null pointer."
+  (ccl:%null-ptr-p ptr))
+
+(defun inc-pointer (ptr offset)
+  "Return a pointer OFFSET bytes past PTR."
+  (ccl:%inc-ptr ptr offset))
+
+(defun pointer-eq (ptr1 ptr2)
+  "Return true if PTR1 and PTR2 point to the same address."
+  (ccl:%ptr-eql ptr1 ptr2))
+
+(defun make-pointer (address)
+  "Return a pointer pointing to ADDRESS."
+  (ccl:%int-to-ptr address))
+
+(defun pointer-address (ptr)
+  "Return the address pointed to by PTR."
+  (ccl:%ptr-to-int ptr))
+
+;;;# Shareable Vectors
+;;;
+;;; This interface is very experimental.  WITH-POINTER-TO-VECTOR-DATA
+;;; should be defined to perform a copy-in/copy-out if the Lisp
+;;; implementation can't do this.
+
+(defun make-shareable-byte-vector (size)
+  "Create a Lisp vector of SIZE bytes that can passed to
+WITH-POINTER-TO-VECTOR-DATA."
+  (make-array size :element-type '(unsigned-byte 8)))
+
+(defmacro with-pointer-to-vector-data ((ptr-var vector) &body body)
+  "Bind PTR-VAR to a foreign pointer to the data in VECTOR."
+  `(ccl:with-pointer-to-ivector (,ptr-var ,vector)
+     , at body))
+
+;;;# Dereferencing
+
+;;; Define the %MEM-REF and %MEM-SET functions, as well as compiler
+;;; macros that optimize the case where the type keyword is constant
+;;; at compile-time.
+(defmacro define-mem-accessors (&body pairs)
+  `(progn
+    (defun %mem-ref (ptr type &optional (offset 0))
+      (ecase type
+        ,@(loop for (keyword fn) in pairs
+                collect `(,keyword (,fn ptr offset)))))
+    (defun %mem-set (value ptr type &optional (offset 0))
+      (ecase type
+        ,@(loop for (keyword fn) in pairs
+                collect `(,keyword (setf (,fn ptr offset) value)))))
+    (define-compiler-macro %mem-ref
+        (&whole form ptr type &optional (offset 0))
+      (if (constantp type)
+          (ecase (eval type)
+            ,@(loop for (keyword fn) in pairs
+                    collect `(,keyword `(,',fn ,ptr ,offset))))
+          form))
+    (define-compiler-macro %mem-set
+        (&whole form value ptr type &optional (offset 0))
+      (if (constantp type)
+          (once-only (value)
+            (ecase (eval type)
+              ,@(loop for (keyword fn) in pairs
+                      collect `(,keyword `(setf (,',fn ,ptr ,offset)
+                                                ,value)))))
+          form))))
+
+(define-mem-accessors
+  (:char %get-signed-byte)
+  (:unsigned-char %get-unsigned-byte)
+  (:short %get-signed-word)
+  (:unsigned-short %get-unsigned-word)
+  (:int %get-signed-long)
+  (:unsigned-int %get-unsigned-long)
+  #+ppc32-target (:long %get-signed-long)
+  #+ppc64-target (:long ccl::%%get-signed-longlong)
+  #+ppc32-target (:unsigned-long %get-unsigned-long)
+  #+ppc64-target (:unsigned-long ccl::%%get-unsigned-longlong)
+  (:long-long ccl::%get-signed-long-long)
+  (:unsigned-long-long ccl::%get-unsigned-long-long)
+  (:float %get-single-float)
+  (:double %get-double-float)
+  (:pointer %get-ptr))
+
+;;;# Calling Foreign Functions
+
+(defun convert-foreign-type (type-keyword)
+  "Convert a CFFI type keyword to an OpenMCL type."
+  (ecase type-keyword
+    (:char                :signed-byte)
+    (:unsigned-char       :unsigned-byte)
+    (:short               :signed-short)
+    (:unsigned-short      :unsigned-short)
+    (:int                 :signed-int)
+    (:unsigned-int        :unsigned-int)
+    (:long                :signed-long)
+    (:unsigned-long       :unsigned-long)
+    (:long-long           :signed-doubleword)
+    (:unsigned-long-long  :unsigned-doubleword)
+    (:float               :single-float)
+    (:double              :double-float)
+    (:pointer             :address)
+    (:void                :void)))
+
+(defun %foreign-type-size (type-keyword)
+  "Return the size in bytes of a foreign type."
+  (/ (ccl::foreign-type-bits
+      (ccl::parse-foreign-type
+       (convert-foreign-type type-keyword))) 8))
+
+;; There be dragons here.  See the following thread for details:
+;; http://clozure.com/pipermail/openmcl-devel/2005-June/002777.html
+(defun %foreign-type-alignment (type-keyword)
+  "Return the alignment in bytes of a foreign type."
+  (/ (ccl::foreign-type-alignment
+      (ccl::parse-foreign-type
+       (convert-foreign-type type-keyword))) 8))
+
+(defun convert-foreign-funcall-types (args)
+  "Convert foreign types for a call to FOREIGN-FUNCALL."
+  (loop for (type arg) on args by #'cddr
+        collect (convert-foreign-type type)
+        if arg collect arg))
+
+(defun convert-external-name (name)
+  "Add an underscore to NAME if necessary for the ABI."
+  #+darwinppc-target (concatenate 'string "_" name)
+  #-darwinppc-target name)
+
+(defmacro %foreign-funcall (function-name &rest args)
+  "Perform a foreign function call, document it more later."
+  `(external-call
+    ,(convert-external-name function-name)
+    ,@(convert-foreign-funcall-types args)))
+
+(defmacro %foreign-funcall-pointer (ptr &rest args)
+  `(ff-call ,ptr ,@(convert-foreign-funcall-types args)))
+
+;;;# Callbacks
+
+;;; The *CALLBACKS* hash table maps CFFI callback names to OpenMCL "macptr"
+;;; entry points.  It is safe to store the pointers directly because
+;;; OpenMCL will update the address of these pointers when a saved image
+;;; is loaded (see CCL::RESTORE-PASCAL-FUNCTIONS).
+(defvar *callbacks* (make-hash-table))
+
+;;; Create a package to contain the symbols for callback functions.  We
+;;; want to redefine callbacks with the same symbol so the internal data
+;;; structures are reused.
+(defpackage #:cffi-callbacks
+  (:use))
+
+;;; Intern a symbol in the CFFI-CALLBACKS package used to name the internal
+;;; callback for NAME.
+(defun intern-callback (name)
+  (intern (format nil "~A::~A" (package-name (symbol-package name))
+                  (symbol-name name))
+          '#:cffi-callbacks))
+
+(defmacro %defcallback (name rettype arg-names arg-types &body body)
+  (let ((cb-name (intern-callback name)))
+    `(progn
+       (defcallback ,cb-name 
+           (,@(mapcan (lambda (sym type)
+                        (list (convert-foreign-type type) sym))
+                      arg-names arg-types)
+            ,(convert-foreign-type rettype))
+         , at body)
+       (setf (gethash ',name *callbacks*) (symbol-value ',cb-name)))))
+
+(defun %callback (name)
+  (or (gethash name *callbacks*)
+      (error "Undefined callback: ~S" name)))
+
+;;;# Loading Foreign Libraries
+
+(defun %load-foreign-library (name)
+  "Load the foreign library NAME."
+  (open-shared-library name))
+
+(defun %close-foreign-library (name)
+  "Close the foreign library NAME."
+  (close-shared-library name)) ; :completely t ?
+
+;;;# Foreign Globals
+
+(defun foreign-symbol-pointer (name)
+  "Returns a pointer to a foreign symbol NAME."
+  (foreign-symbol-address (convert-external-name name)))

Added: branches/xml-class-rework/thirdparty/cffi/src/cffi-sbcl.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/src/cffi-sbcl.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/src/cffi-sbcl.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,315 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; cffi-sbcl.lisp --- CFFI-SYS implementation for SBCL.
+;;;
+;;; Copyright (C) 2005, James Bielman  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+;;;# Administrivia
+
+(defpackage #:cffi-sys
+  (:use #:common-lisp #:sb-alien #:cffi-utils)
+  (:export
+   #:canonicalize-symbol-name-case
+   #:pointerp
+   #:pointer-eq
+   #:null-pointer
+   #:null-pointer-p
+   #:inc-pointer
+   #:make-pointer
+   #:pointer-address
+   #:%foreign-alloc
+   #:foreign-free
+   #:with-foreign-pointer
+   #:%foreign-funcall
+   #:%foreign-funcall-pointer
+   #:%foreign-type-alignment
+   #:%foreign-type-size
+   #:%load-foreign-library
+   #:%close-foreign-library
+   #:%mem-ref
+   #:%mem-set
+   #:make-shareable-byte-vector
+   #:with-pointer-to-vector-data
+   #:foreign-symbol-pointer
+   #:%defcallback
+   #:%callback))
+
+(in-package #:cffi-sys)
+
+;;;# Features
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (mapc (lambda (feature) (pushnew feature *features*))
+        '(;; OS/CPU features.
+          #+darwin  cffi-features:darwin
+          #+(and unix (not win32)) cffi-features:unix
+          #+win32   cffi-features:windows
+          #+x86     cffi-features:x86
+          #+x86-64  cffi-features:x86-64
+          #+(and ppc (not ppc64)) cffi-features:ppc32
+          )))
+
+;;; Symbol case.
+
+(defun canonicalize-symbol-name-case (name)
+  (declare (string name))
+  (string-upcase name))
+
+;;;# Basic Pointer Operations
+
+(defun pointerp (ptr)
+  "Return true if PTR is a foreign pointer."
+  (sb-sys:system-area-pointer-p ptr))
+
+(defun pointer-eq (ptr1 ptr2)
+  "Return true if PTR1 and PTR2 point to the same address."
+  (sb-sys:sap= ptr1 ptr2))
+
+(defun null-pointer ()
+  "Construct and return a null pointer."
+  (sb-sys:int-sap 0))
+
+(defun null-pointer-p (ptr)
+  "Return true if PTR is a null pointer."
+  (zerop (sb-sys:sap-int ptr)))
+
+(defun inc-pointer (ptr offset)
+  "Return a pointer pointing OFFSET bytes past PTR."
+  (sb-sys:sap+ ptr offset))
+
+(defun make-pointer (address)
+  "Return a pointer pointing to ADDRESS."
+  (sb-sys:int-sap address))
+
+(defun pointer-address (ptr)
+  "Return the address pointed to by PTR."
+  (sb-sys:sap-int ptr))
+
+;;;# Allocation
+;;;
+;;; Functions and macros for allocating foreign memory on the stack
+;;; and on the heap.  The main CFFI package defines macros that wrap
+;;; FOREIGN-ALLOC and FOREIGN-FREE in UNWIND-PROTECT for the common usage
+;;; when the memory has dynamic extent.
+
+(defun %foreign-alloc (size)
+  "Allocate SIZE bytes on the heap and return a pointer."
+  (alien-sap (make-alien (unsigned 8) size)))
+
+(defun foreign-free (ptr)
+  "Free a PTR allocated by FOREIGN-ALLOC."
+  (free-alien (sap-alien ptr (* (unsigned 8)))))
+
+(defmacro with-foreign-pointer ((var size &optional size-var) &body body)
+  "Bind VAR to SIZE bytes of foreign memory during BODY.  The
+pointer in VAR is invalid beyond the dynamic extent of BODY, and
+may be stack-allocated if supported by the implementation.  If
+SIZE-VAR is supplied, it will be bound to SIZE during BODY."
+  (unless size-var
+    (setf size-var (gensym "SIZE")))
+  ;; If the size is constant we can stack-allocate.
+  (if (constantp size)
+      (let ((alien-var (gensym "ALIEN")))
+        `(with-alien ((,alien-var (array (unsigned 8) ,(eval size))))
+           (let ((,size-var ,(eval size))
+                 (,var (alien-sap ,alien-var)))
+             (declare (ignorable ,size-var))
+             , at body)))
+      `(let* ((,size-var ,size)
+              (,var (%foreign-alloc ,size-var)))
+         (unwind-protect
+              (progn , at body)
+           (foreign-free ,var)))))
+
+;;;# Shareable Vectors
+;;;
+;;; This interface is very experimental.  WITH-POINTER-TO-VECTOR-DATA
+;;; should be defined to perform a copy-in/copy-out if the Lisp
+;;; implementation can't do this.
+
+(defun make-shareable-byte-vector (size)
+  "Create a Lisp vector of SIZE bytes can passed to
+WITH-POINTER-TO-VECTOR-DATA."
+  (make-array size :element-type '(unsigned-byte 8)))
+
+(defmacro with-pointer-to-vector-data ((ptr-var vector) &body body)
+  "Bind PTR-VAR to a foreign pointer to the data in VECTOR."
+  (let ((vector-var (gensym "VECTOR")))
+    `(let ((,vector-var ,vector))
+       (sb-sys:with-pinned-objects (,vector-var)
+         (let ((,ptr-var (sb-sys:vector-sap ,vector-var)))
+           , at body)))))
+
+;;;# Dereferencing
+
+;;; Define the %MEM-REF and %MEM-SET functions, as well as compiler
+;;; macros that optimize the case where the type keyword is constant
+;;; at compile-time.
+(defmacro define-mem-accessors (&body pairs)
+  `(progn
+     (defun %mem-ref (ptr type &optional (offset 0))
+       (ecase type
+         ,@(loop for (keyword fn) in pairs
+                 collect `(,keyword (,fn ptr offset)))))
+     (defun %mem-set (value ptr type &optional (offset 0))
+       (ecase type
+         ,@(loop for (keyword fn) in pairs
+                 collect `(,keyword (setf (,fn ptr offset) value)))))
+     (define-compiler-macro %mem-ref
+         (&whole form ptr type &optional (offset 0))
+       (if (constantp type)
+           (ecase (eval type)
+             ,@(loop for (keyword fn) in pairs
+                     collect `(,keyword `(,',fn ,ptr ,offset))))
+           form))
+     (define-compiler-macro %mem-set
+         (&whole form value ptr type &optional (offset 0))
+       (if (constantp type)
+           (once-only (value)
+             (ecase (eval type)
+               ,@(loop for (keyword fn) in pairs
+                       collect `(,keyword `(setf (,',fn ,ptr ,offset)
+                                                 ,value)))))
+           form))))
+
+(define-mem-accessors
+  (:char sb-sys:signed-sap-ref-8)
+  (:unsigned-char sb-sys:sap-ref-8)
+  (:short sb-sys:signed-sap-ref-16)
+  (:unsigned-short sb-sys:sap-ref-16)
+  (:int sb-sys:signed-sap-ref-32)
+  (:unsigned-int sb-sys:sap-ref-32)
+  (:long sb-sys:signed-sap-ref-word)
+  (:unsigned-long sb-sys:sap-ref-word)
+  (:long-long sb-sys:signed-sap-ref-64)
+  (:unsigned-long-long sb-sys:sap-ref-64)
+  (:float sb-sys:sap-ref-single)
+  (:double sb-sys:sap-ref-double)
+  (:pointer sb-sys:sap-ref-sap))
+
+;;;# Calling Foreign Functions
+
+(defun convert-foreign-type (type-keyword)
+  "Convert a CFFI type keyword to an SB-ALIEN type."
+  (ecase type-keyword
+    (:char               'char)
+    (:unsigned-char      'unsigned-char)
+    (:short              'short)
+    (:unsigned-short     'unsigned-short)
+    (:int                'int)
+    (:unsigned-int       'unsigned-int)
+    (:long               'long)
+    (:unsigned-long      'unsigned-long)
+    (:long-long          'long-long)
+    (:unsigned-long-long 'unsigned-long-long)
+    (:float              'single-float)
+    (:double             'double-float)
+    (:pointer            'system-area-pointer)
+    (:void               'void)))
+
+(defun %foreign-type-size (type-keyword)
+  "Return the size in bytes of a foreign type."
+  (/ (sb-alien-internals:alien-type-bits
+      (sb-alien-internals:parse-alien-type
+       (convert-foreign-type type-keyword) nil)) 8))
+
+(defun %foreign-type-alignment (type-keyword)
+  "Return the alignment in bytes of a foreign type."
+  #+(and darwin ppc (not ppc64))
+  (when (member type-keyword '(:double :long-long))
+    (return-from %foreign-type-alignment 8))
+  ;; No override necessary for other types...
+  (/ (sb-alien-internals:alien-type-alignment
+      (sb-alien-internals:parse-alien-type
+       (convert-foreign-type type-keyword) nil)) 8))
+
+(defun foreign-funcall-type-and-args (args)
+  "Return an SB-ALIEN function type for ARGS."
+  (let ((return-type 'void))
+    (loop for (type arg) on args by #'cddr
+          if arg collect (convert-foreign-type type) into types
+          and collect arg into fargs
+          else do (setf return-type (convert-foreign-type type))
+          finally (return (values types fargs return-type)))))
+
+(defmacro %%foreign-funcall (name types fargs rettype)
+  "Internal guts of %FOREIGN-FUNCALL."
+  `(alien-funcall
+    (extern-alien ,name (function ,rettype , at types))
+    , at fargs))
+
+(defmacro %foreign-funcall (name &rest args)
+  "Perform a foreign function call, document it more later."
+  (multiple-value-bind (types fargs rettype)
+      (foreign-funcall-type-and-args args)
+    `(%%foreign-funcall ,name ,types ,fargs ,rettype)))
+
+(defmacro %foreign-funcall-pointer (ptr &rest args)
+  "Funcall a pointer to a foreign function."
+  (multiple-value-bind (types fargs rettype)
+      (foreign-funcall-type-and-args args)
+    (with-unique-names (function)
+      `(with-alien ((,function (* (function ,rettype , at types)) ,ptr))
+         (alien-funcall ,function , at fargs)))))
+
+;;;# Callbacks
+
+;;; The *CALLBACKS* hash table contains a direct mapping of CFFI
+;;; callback names to SYSTEM-AREA-POINTERs obtained by ALIEN-LAMBDA.
+;;; SBCL will maintain the addresses of the callbacks across saved
+;;; images, so it is safe to store the pointers directly.
+(defvar *callbacks* (make-hash-table))
+
+(defmacro %defcallback (name rettype arg-names arg-types &body body)
+  `(setf (gethash ',name *callbacks*)
+         (alien-sap
+          (sb-alien::alien-lambda ,(convert-foreign-type rettype)
+              ,(mapcar (lambda (sym type)
+                         (list sym (convert-foreign-type type)))
+                       arg-names arg-types)
+            , at body))))
+
+(defun %callback (name)
+  (or (gethash name *callbacks*)
+      (error "Undefined callback: ~S" name)))
+
+;;;# Loading and Closing Foreign Libraries
+
+(defun %load-foreign-library (name)
+  "Load the foreign library NAME."
+  (load-shared-object name))
+
+(defun %close-foreign-library (name)
+  "Closes the foreign library NAME."
+  (sb-alien::dlclose-or-lose
+   (find name sb-alien::*shared-objects*
+         :key #'sb-alien::shared-object-file
+         :test #'string=)))
+
+;;;# Foreign Globals
+
+(defun foreign-symbol-pointer (name)
+  "Returns a pointer to a foreign symbol NAME."
+  (let-when (address (sb-sys:find-foreign-symbol-address name))
+    (sb-sys:int-sap address)))

Added: branches/xml-class-rework/thirdparty/cffi/src/cffi-scl.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/src/cffi-scl.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/src/cffi-scl.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,328 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; cffi-scl.lisp --- CFFI-SYS implementation for the Scieneer Common Lisp.
+;;;
+;;; Copyright (C) 2005, James Bielman  
+;;; Copyright (C) 2006, Scieneer Pty Ltd.
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+;;; For posterity, a few optimizations we might use in the future:
+
+#-(and)
+(defun lisp-string-to-foreign (string ptr size)
+  (c-call::deport-string-to-system-area string ptr size :iso-8859-1))
+
+#-(and)
+(defun foreign-string-to-lisp (ptr &optional (size most-positive-fixnum)
+                               (null-terminated-p t))
+  (unless (null-pointer-p ptr)
+    (if null-terminated-p
+        (c-call::naturalize-c-string ptr :iso-8859-1)
+        (c-call::naturalize-c-string ptr :iso-8859-1 size))))
+
+;;;# Administrivia
+
+(defpackage #:cffi-sys
+  (:use #:common-lisp #:alien #:c-call #:cffi-utils)
+  (:export
+   #:canonicalize-symbol-name-case
+   #:pointerp
+   #:pointer-eq
+   #:null-pointer
+   #:null-pointer-p
+   #:inc-pointer
+   #:make-pointer
+   #:pointer-address
+   #:%foreign-alloc
+   #:foreign-free
+   #:with-foreign-pointer
+   #:%foreign-funcall
+   #:%foreign-funcall-pointer
+   #:%foreign-type-alignment
+   #:%foreign-type-size
+   #:%load-foreign-library
+   #:%close-foreign-library
+   #:%mem-ref
+   #:%mem-set
+   #:make-shareable-byte-vector
+   #:with-pointer-to-vector-data
+   #:foreign-symbol-pointer
+   #:%defcallback
+   #:%callback))
+
+(in-package #:cffi-sys)
+
+;;;# Features
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (mapc (lambda (feature) (pushnew feature *features*))
+        '(;; OS/CPU features.
+          #+unix    cffi-features:unix
+          #+x86     cffi-features:x86
+          #+amd64   cffi-features:x86-64
+          #+(and ppc (not ppc64)) cffi-features:ppc32
+          )))
+
+;;; Symbol case.
+
+(defun canonicalize-symbol-name-case (name)
+  (declare (string name))
+  (if (eq ext:*case-mode* :upper)
+      (string-upcase name)
+      (string-downcase name)))
+
+;;;# Basic Pointer Operations
+
+(declaim (inline pointerp))
+(defun pointerp (ptr)
+  "Return true if 'ptr is a foreign pointer."
+  (sys:system-area-pointer-p ptr))
+
+(declaim (inline pointer-eq))
+(defun pointer-eq (ptr1 ptr2)
+  "Return true if 'ptr1 and 'ptr2 point to the same address."
+  (sys:sap= ptr1 ptr2))
+
+(declaim (inline null-pointer))
+(defun null-pointer ()
+  "Construct and return a null pointer."
+  (sys:int-sap 0))
+
+(declaim (inline null-pointer-p))
+(defun null-pointer-p (ptr)
+  "Return true if 'ptr is a null pointer."
+  (zerop (sys:sap-int ptr)))
+
+(declaim (inline inc-pointer))
+(defun inc-pointer (ptr offset)
+  "Return a pointer pointing 'offset bytes past 'ptr."
+  (sys:sap+ ptr offset))
+
+(declaim (inline make-pointer)) 
+(defun make-pointer (address)
+  "Return a pointer pointing to 'address."
+  (sys:int-sap address))
+
+(declaim (inline pointer-address))
+(defun pointer-address (ptr)
+  "Return the address pointed to by 'ptr."
+  (sys:sap-int ptr))
+
+(defmacro with-foreign-pointer ((var size &optional size-var) &body body)
+  "Bind 'var to 'size bytes of foreign memory during 'body.  The
+  pointer in 'var is invalid beyond the dynamic extent of 'body, and
+  may be stack-allocated if supported by the implementation.  If
+  'size-var is supplied, it will be bound to 'size during 'body."
+  (unless size-var
+    (setf size-var (gensym (symbol-name '#:size))))
+  ;; If the size is constant we can stack-allocate.
+  (cond ((constantp size)
+         (let ((alien-var (gensym (symbol-name '#:alien))))
+           `(with-alien ((,alien-var (array (unsigned 8) ,(eval size))))
+             (let ((,size-var ,size)
+                   (,var (alien-sap ,alien-var)))
+               (declare (ignorable ,size-var))
+               , at body))))
+        (t
+         `(let ((,size-var ,size))
+            (alien:with-bytes (,var ,size-var)
+              , at body)))))
+
+;;;# Allocation
+;;;
+;;; Functions and macros for allocating foreign memory on the stack and on the
+;;; heap.  The main CFFI package defines macros that wrap 'foreign-alloc and
+;;; 'foreign-free in 'unwind-protect for the common usage when the memory has
+;;; dynamic extent.
+
+(defun %foreign-alloc (size)
+  "Allocate 'size bytes on the heap and return a pointer."
+  (declare (type (unsigned-byte #-64bit 32 #+64bit 64) size))
+  (alien-funcall (extern-alien "malloc"
+                               (function system-area-pointer unsigned))
+                 size))
+
+(defun foreign-free (ptr)
+  "Free a 'ptr allocated by 'foreign-alloc."
+  (declare (type system-area-pointer ptr))
+  (alien-funcall (extern-alien "free"
+                               (function (values) system-area-pointer))
+                 ptr))
+
+;;;# Shareable Vectors
+
+(defun make-shareable-byte-vector (size)
+  "Create a Lisp vector of 'size bytes that can passed to
+  'with-pointer-to-vector-data."
+  (make-array size :element-type '(unsigned-byte 8)))
+
+(defmacro with-pointer-to-vector-data ((ptr-var vector) &body body)
+  "Bind 'ptr-var to a foreign pointer to the data in 'vector."
+  (let ((vector-var (gensym (symbol-name '#:vector))))
+    `(let ((,vector-var ,vector))
+       (ext:with-pinned-object (,vector-var)
+         (let ((,ptr-var (sys:vector-sap ,vector-var)))
+           , at body)))))
+
+;;;# Dereferencing
+
+;;; Define the %MEM-REF and %MEM-SET functions, as well as compiler
+;;; macros that optimize the case where the type keyword is constant
+;;; at compile-time.
+(defmacro define-mem-accessors (&body pairs)
+  `(progn
+    (defun %mem-ref (ptr type &optional (offset 0))
+      (ecase type
+        ,@(loop for (keyword fn) in pairs
+                collect `(,keyword (,fn ptr offset)))))
+    (defun %mem-set (value ptr type &optional (offset 0))
+      (ecase type
+        ,@(loop for (keyword fn) in pairs
+                collect `(,keyword (setf (,fn ptr offset) value)))))
+    (define-compiler-macro %mem-ref
+        (&whole form ptr type &optional (offset 0))
+      (if (constantp type)
+          (ecase (eval type)
+            ,@(loop for (keyword fn) in pairs
+                    collect `(,keyword `(,',fn ,ptr ,offset))))
+          form))
+    (define-compiler-macro %mem-set
+        (&whole form value ptr type &optional (offset 0))
+      (if (constantp type)
+          (once-only (value)
+            (ecase (eval type)
+              ,@(loop for (keyword fn) in pairs
+                      collect `(,keyword `(setf (,',fn ,ptr ,offset)
+                                                ,value)))))
+          form))))
+
+(define-mem-accessors
+  (:char sys:signed-sap-ref-8)
+  (:unsigned-char sys:sap-ref-8)
+  (:short sys:signed-sap-ref-16)
+  (:unsigned-short sys:sap-ref-16)
+  (:int sys:signed-sap-ref-32)
+  (:unsigned-int sys:sap-ref-32)
+  (:long #-64bit sys:signed-sap-ref-32 #+64bit sys:signed-sap-ref-64)
+  (:unsigned-long #-64bit sys:sap-ref-32 #+64bit sys:sap-ref-64)
+  (:long-long sys:signed-sap-ref-64)
+  (:unsigned-long-long sys:sap-ref-64)
+  (:float sys:sap-ref-single)
+  (:double sys:sap-ref-double)
+  #+long-float (:long-double sys:sap-ref-long)
+  (:pointer sys:sap-ref-sap))
+
+;;;# Calling Foreign Functions
+
+(defun convert-foreign-type (type-keyword)
+  "Convert a CFFI type keyword to an ALIEN type."
+  (ecase type-keyword
+    (:char               'char)
+    (:unsigned-char      'unsigned-char)
+    (:short              'short)
+    (:unsigned-short     'unsigned-short)
+    (:int                'int)
+    (:unsigned-int       'unsigned-int)
+    (:long               'long)
+    (:unsigned-long      'unsigned-long)
+    (:long-long          '(signed 64))
+    (:unsigned-long-long '(unsigned 64))
+    (:float              'single-float)
+    (:double             'double-float)
+    #+long-float
+    (:long-double        'long-float)
+    (:pointer            'system-area-pointer)
+    (:void               'void)))
+
+(defun %foreign-type-size (type-keyword)
+  "Return the size in bytes of a foreign type."
+  (values (truncate (alien-internals:alien-type-bits
+                     (alien-internals:parse-alien-type
+                      (convert-foreign-type type-keyword)))
+                    8)))
+
+(defun %foreign-type-alignment (type-keyword)
+  "Return the alignment in bytes of a foreign type."
+  (values (truncate (alien-internals:alien-type-alignment
+                     (alien-internals:parse-alien-type
+                      (convert-foreign-type type-keyword)))
+                    8)))
+
+(defun foreign-funcall-type-and-args (args)
+  "Return an 'alien function type for 'args."
+  (let ((return-type nil))
+    (loop for (type arg) on args by #'cddr
+          if arg collect (convert-foreign-type type) into types
+          and collect arg into fargs
+          else do (setf return-type (convert-foreign-type type))
+          finally (return (values types fargs return-type)))))
+
+(defmacro %%foreign-funcall (name types fargs rettype)
+  "Internal guts of '%foreign-funcall."
+  `(alien-funcall (extern-alien ,name (function ,rettype , at types))
+                  , at fargs))
+
+(defmacro %foreign-funcall (name &rest args)
+  "Perform a foreign function call, document it more later."
+  (multiple-value-bind (types fargs rettype)
+      (foreign-funcall-type-and-args args)
+    `(%%foreign-funcall ,name ,types ,fargs ,rettype)))
+
+(defmacro %foreign-funcall-pointer (ptr &rest args)
+  "Funcall a pointer to a foreign function."
+  (multiple-value-bind (types fargs rettype)
+      (foreign-funcall-type-and-args args)
+    (with-unique-names (function)
+      `(with-alien ((,function (* (function ,rettype , at types)) ,ptr))
+         (alien-funcall ,function , at fargs)))))
+
+;;; Callbacks
+
+(defmacro %defcallback (name rettype arg-names arg-types &body body)
+   `(alien:defcallback ,name
+       (,(convert-foreign-type rettype)
+         ,@(mapcar (lambda (sym type)
+                     (list sym (convert-foreign-type type)))
+                   arg-names arg-types))
+     , at body))
+
+(declaim (inline %callback))
+(defun %callback (name)
+  (alien:callback-sap name))
+
+;;;# Loading and Closing Foreign Libraries
+
+(defun %load-foreign-library (name)
+  "Load the foreign library 'name."
+  (ext:load-dynamic-object name))
+
+(defun %close-foreign-library (name)
+  "Closes the foreign library 'name."
+  (ext:close-dynamic-object name))
+
+;;;# Foreign Globals
+
+(defun foreign-symbol-pointer (name)
+  "Returns a pointer to a foreign symbol 'name."
+  (let ((sap (sys:foreign-symbol-address name)))
+    (if (zerop (sys:sap-int sap)) nil sap)))

Added: branches/xml-class-rework/thirdparty/cffi/src/early-types.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/src/early-types.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/src/early-types.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,498 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; early-types.lisp --- Low-level foreign type operations.
+;;;
+;;; Copyright (C) 2005, James Bielman  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+;;;# Early Type Definitions
+;;;
+;;; This module contains basic operations on foreign types.  These
+;;; definitions are in a separate file because they may be used in
+;;; compiler macros defined later on.
+
+(in-package #:cffi)
+
+;;;# Foreign Types
+
+(defvar *foreign-types* (make-hash-table)
+  "Hash table of all user-defined foreign types.")
+
+(defun find-type (name)
+  "Return the foreign type instance for NAME or nil."
+  (gethash name *foreign-types*))
+  
+(defun find-type-or-lose (name)
+  "Return the foreign type instance for NAME or signal an error."
+  (or (find-type name)
+      (error "Undefined foreign type: ~S" name)))
+
+(defun notice-foreign-type (type)
+  "Inserts TYPE in the *FOREIGN-TYPES* hashtable."
+  (setf (gethash (name type) *foreign-types*) type)
+  (name type))
+
+;;;# Parsing Type Specifications
+;;;
+;;; Type specifications are of the form (type {args}*). The
+;;; type parser can specify how its arguments should look like
+;;; through a lambda list.
+;;;
+;;; "type" is a shortcut for "(type)", ie, no args were specified.
+;;;
+;;; Examples of such types: boolean, (boolean), (boolean :int)
+;;; If the boolean type parser specifies the lambda list:
+;;; &optional (base-type :int), then all of the above three
+;;; type specs would be parsed to an identical type.
+;;;
+;;; Type parsers, defined with DEFINE-TYPE-SPEC-PARSER should
+;;; return a subtype of the foreign-type class.
+
+(defvar *type-parsers* (make-hash-table)
+  "Hash table of defined type parsers.")
+
+(defun find-type-parser (symbol)
+  "Return the type parser for SYMBOL."
+  (gethash symbol *type-parsers*))
+
+(defun (setf find-type-parser) (func symbol)
+  "Set the type parser for SYMBOL."
+  (setf (gethash symbol *type-parsers*) func))
+
+(defmacro define-type-spec-parser (symbol lambda-list &body body)
+  "Define a type parser on SYMBOL and lists whose CAR is SYMBOL."
+  (when (stringp (car body)) ; discard-docstring
+    (setq body (cdr body)))
+  `(eval-when (:compile-toplevel :load-toplevel :execute)
+     (setf (find-type-parser ',symbol)
+           (lambda ,lambda-list , at body))))
+
+(defun parse-type (type-spec-or-name)
+  (or (find-type type-spec-or-name)
+      (let* ((type-spec (mklist type-spec-or-name))
+             (parser (find-type-parser (car type-spec))))
+        (if parser
+            (apply parser (cdr type-spec))
+            (error "Unknown CFFI type: ~S." type-spec-or-name)))))
+
+;;;# Generic Functions on Types
+
+(defgeneric canonicalize (foreign-type)
+  (:documentation
+   "Return the built-in foreign type for FOREIGN-TYPE.
+Signals an error if FOREIGN-TYPE is undefined."))
+
+(defgeneric aggregatep (foreign-type)
+  (:documentation
+   "Return true if FOREIGN-TYPE is an aggregate type."))
+
+(defgeneric foreign-type-alignment (foreign-type)
+  (:documentation
+   "Return the structure alignment in bytes of a foreign type."))
+
+(defgeneric foreign-type-size (foreign-type)
+  (:documentation
+   "Return the size in bytes of a foreign type."))
+
+(defgeneric unparse (type-name type-class)
+  (:documentation
+   "Unparse FOREIGN-TYPE to a type specification (symbol or list)."))
+
+(defgeneric translate-p (foreign-type)
+  (:documentation
+   "Return true if type translators should run on FOREIGN-TYPE."))
+
+;;;# Foreign Types
+
+(defclass foreign-type ()
+  ((name
+    ;; Name of this foreign type, a symbol.
+    :initform (gensym "ANONYMOUS-CFFI-TYPE")
+    :initarg :name
+    :accessor name))
+  (:documentation "Contains information about a basic foreign type."))
+
+(defmethod print-object ((type foreign-type) stream)
+  "Print a FOREIGN-TYPE instance to STREAM unreadably."
+  (print-unreadable-object (type stream :type t :identity nil)
+    (format stream "~S" (name type))))
+
+(defmethod make-load-form ((type foreign-type) &optional env)
+  "Return the form used to dump types to a FASL file."
+  (declare (ignore env))
+  `(parse-type ',(unparse-type type)))
+
+(defun canonicalize-foreign-type (type)
+  "Convert TYPE to a built-in type by following aliases.
+Signals an error if the type cannot be resolved."
+  (canonicalize (parse-type type)))
+
+(defmethod unparse (name (type foreign-type))
+  "Default method to unparse TYPE to its name."
+  (declare (ignore name))
+  (name type))
+
+(defun unparse-type (type)
+  "Unparse a foreign type to a symbol or list type spec."
+  (unparse (name type) type))
+
+(defmethod foreign-type-size (type)
+  "Return the size in bytes of a foreign type."
+  (foreign-type-size (parse-type type)))
+
+(defmethod translate-p ((type foreign-type))
+  "By default, types will be translated."
+  t)
+
+;;;# Built-In Foreign Types
+
+(defclass foreign-built-in-type (foreign-type)
+  ((type-keyword
+    ;; Keyword in CFFI-SYS representing this type.
+    :initform (error "A type keyword is required.")
+    :initarg :type-keyword
+    :accessor type-keyword))
+  (:documentation "A built-in foreign type."))
+
+(defmethod canonicalize ((type foreign-built-in-type))
+  "Return the built-in type keyword for TYPE."
+  (type-keyword type))
+
+(defmethod aggregatep ((type foreign-built-in-type))
+  "Returns false, built-in types are never aggregate types."
+  nil)
+
+(defmethod foreign-type-alignment ((type foreign-built-in-type))
+  "Return the alignment of a built-in type."
+  (%foreign-type-alignment (type-keyword type)))
+
+(defmethod foreign-type-size ((type foreign-built-in-type))
+  "Return the size of a built-in type."
+  (%foreign-type-size (type-keyword type)))
+
+(defmethod translate-p ((type foreign-built-in-type))
+  "Built-in types are never translated."
+  nil)
+
+(defmacro define-built-in-foreign-type (keyword)
+  "Defines a built-in foreign-type."
+  `(eval-when (:compile-toplevel :load-toplevel :execute)
+     (notice-foreign-type
+      (make-instance 'foreign-built-in-type :name ,keyword
+                     :type-keyword ,keyword))))
+
+;;;# Foreign Typedefs
+;;;
+;;; We have two classes: foreign-type-alias and foreign-typedef.
+;;; The former is a direct super-class of the latter. The only
+;;; difference between the two is that foreign-typedef has different
+;;; behaviour wrt type translations. (see types.lisp)
+
+(defclass foreign-type-alias (foreign-type)
+  ((actual-type
+    ;; The FOREIGN-TYPE instance this type is an alias for.
+    :initarg :actual-type
+    :accessor actual-type)
+   (translate-p
+    ;; If true, this type should be translated (the default).
+    :initform t
+    :initarg :translate-p
+    :accessor translate-p))
+  (:documentation "A type that aliases another type."))
+
+(defmethod canonicalize ((type foreign-type-alias))
+  "Return the built-in type keyword for TYPE."
+  (canonicalize (actual-type type)))
+
+(defmethod aggregatep ((type foreign-type-alias))
+  "Return true if TYPE's actual type is aggregate."
+  (aggregatep (actual-type type)))
+
+(defmethod foreign-type-alignment ((type foreign-type-alias))
+  "Return the alignment of a foreign typedef."
+  (foreign-type-alignment (actual-type type)))
+
+(defmethod foreign-type-size ((type foreign-type-alias))
+  "Return the size in bytes of a foreign typedef."
+  (foreign-type-size (actual-type type)))
+
+(defclass foreign-typedef (foreign-type-alias)
+  ())
+
+;;; This should probably be an argument to parse-type.
+;;; So we'd have: (parse-type foo :follow-typedefs t)
+;;; instead of (follow-typedefs (parse-type foo)) ? --luis
+(defun follow-typedefs (type)
+  (if (eq (type-of type) 'foreign-typedef)
+      (follow-typedefs (actual-type type))
+      type))
+
+;;;# Structure Type
+
+(defclass foreign-struct-type (foreign-type)
+  ((slots
+    ;; Hash table of slots in this structure, keyed by name.
+    :initform (make-hash-table)
+    :initarg :slots
+    :accessor slots)
+   (size
+    ;; Cached size in bytes of this structure.
+    :initarg :size
+    :accessor size)
+   (alignment
+    ;; This struct's alignment requirements
+    :initarg :alignment
+    :accessor alignment))
+  (:documentation "Hash table of plists containing slot information."))
+
+(defmethod canonicalize ((type foreign-struct-type))
+  "Returns :POINTER, since structures can not be passed by value."
+  :pointer)
+
+(defmethod aggregatep ((type foreign-struct-type))
+  "Returns true, structure types are aggregate."
+  t)
+
+(defmethod foreign-type-size ((type foreign-struct-type))
+  "Return the size in bytes of a foreign structure type."
+  (size type))
+
+(defmethod foreign-type-alignment ((type foreign-struct-type))
+  "Return the alignment requirements for this struct."
+  (alignment type))
+
+;;;# Type Translators
+;;;
+;;; Type translation is now done with generic functions at runtime.
+;;;
+;;; The main internal interface to type translation is through the
+;;; generic functions TRANSLATE-TYPE-{TO,FROM}-FOREIGN and
+;;; FREE-TYPE-TRANSLATED-OBJECT.  These should be specialized for
+;;; subclasses of FOREIGN-TYPE requiring translation.
+;;;
+;;; User-defined type translators are defined by specializing
+;;; additional methods that are called by the internal methods
+;;; specialized on FOREIGN-TYPEDEF.  These methods dispatch on the
+;;; name of the type.
+
+;;; Translate VALUE to a foreign object of the type represented by
+;;; TYPE, which will be a subclass of FOREIGN-TYPE.  Returns the
+;;; foreign value and an optional second value which will be passed to
+;;; FREE-TYPE-TRANSLATED-OBJECT as the PARAM argument.
+(defgeneric translate-type-to-foreign (value type)
+  (:method (value type)
+    (declare (ignore type))
+    value))
+
+;;; Translate the foreign object VALUE from the type repsented by
+;;; TYPE, which will be a subclass of FOREIGN-TYPE.  Returns the
+;;; converted Lisp value.
+(defgeneric translate-type-from-foreign (value type)
+  (:method (value type)
+    (declare (ignore type))
+    value))
+
+;;; Free an object allocated by TRANSLATE-TYPE-TO-FOREIGN.  VALUE is a
+;;; foreign object of the type represented by TYPE, which will be a
+;;; FOREIGN-TYPE subclass.  PARAM, if present, contains the second
+;;; value returned by TRANSLATE-TYPE-TO-FOREIGN, and is used to
+;;; communicate between the two functions.
+(defgeneric free-type-translated-object (value type param)
+  (:method (value type param)
+    (declare (ignore value type param))))
+
+;;;## Translations for Typedefs
+;;;
+;;; By default, the translation methods for type definitions delegate
+;;; to the translation methods for the ACTUAL-TYPE of the typedef.
+;;;
+;;; The user is allowed to intervene in this process by specializing
+;;; TRANSLATE-TO-FOREIGN, TRANSLATE-FROM-FOREIGN, and
+;;; FREE-TRANSLATED-OBJECT on the name of the typedef.
+
+;;; Exported hook method allowing specific typedefs to define custom
+;;; translators to convert VALUE to the foreign type named by NAME.
+(defgeneric translate-to-foreign (value name)
+  (:method (value name)
+    (declare (ignore name))
+    value))
+
+;;; Exported hook method allowing specific typedefs to define custom
+;;; translators to convert VALUE from the foreign type named by NAME.
+(defgeneric translate-from-foreign (value name)
+  (:method (value name)
+    (declare (ignore name))
+    value))
+
+;;; Exported hook method allowing specific typedefs to free objects of
+;;; type NAME allocated by TRANSLATE-TO-FOREIGN.
+(defgeneric free-translated-object (value name param)
+  (:method (value name param)
+    (declare (ignore value name param))))
+
+;;; Default translator to foreign for typedefs.  We build a list out
+;;; of the second value returned from each translator so we can pass
+;;; each parameter to the appropriate free method when freeing the
+;;; object.
+(defmethod translate-type-to-foreign (value (type foreign-typedef))
+  (multiple-value-bind (value param)
+      (translate-to-foreign value (name type))
+    (multiple-value-bind (new-value new-param)
+        (translate-type-to-foreign value (actual-type type))
+      (values new-value (cons param new-param)))))
+
+;;; Default translator from foreign for typedefs.
+(defmethod translate-type-from-foreign (value (type foreign-typedef))
+  (translate-from-foreign
+   (translate-type-from-foreign value (actual-type type))
+   (name type)))
+
+;;; Default method for freeing translated foreign typedefs.  PARAM
+;;; will actually be a list of parameters to pass to each translator
+;;; method as returned by TRANSLATE-TYPE-TO-FOREIGN.
+(defmethod free-type-translated-object (value (type foreign-typedef) param)
+  (free-translated-object value (name type) (car param))
+  (free-type-translated-object value (actual-type type) (cdr param)))
+
+;;;## Macroexpansion Time Translation
+;;;
+;;; The following expand-* generic functions are similar to their
+;;; translate-* counterparts but are usually called at macroexpansion
+;;; time. They offer a way to optimize the runtime translators.
+;;;
+;;; The default methods expand to forms calling the runtime translators
+;;; unless TRANSLATE-P returns NIL for the type.
+
+(defun %expand-type-to-foreign-dyn (value var body type)
+  (with-unique-names (param)
+    (if (translate-p type)
+        `(multiple-value-bind (,var ,param)
+             (translate-type-to-foreign ,value ,type)
+           (unwind-protect
+                (progn , at body)
+             (free-type-translated-object ,var ,type ,param)))
+        `(let ((,var ,value))
+           , at body))))
+
+(defun %expand-type-to-foreign (value type)
+  (if (translate-p type)
+      `(values (translate-type-to-foreign ,value ,type))
+      value))
+
+(defun %expand-type-from-foreign (value type)
+  (if (translate-p type)
+      `(translate-type-from-foreign ,value ,type)
+      `(values ,value)))
+
+;;; This special variable is bound by the various :around methods
+;;; below to the respective form generated by the above %EXPAND-*
+;;; functions.  This way, an expander can "bail out" by calling the
+;;; next method.  All 6 of the below-defined GFs have a default method
+;;; that simply answers the rtf bound by the default :around method.
+(defvar *runtime-translator-form*)
+
+(defun specializedp (gf &rest args)
+  "Answer whether GF has more than one applicable method for ARGS."
+  (typep (compute-applicable-methods gf args) '(cons t cons)))
+
+(defgeneric expand-type-to-foreign-dyn (value var body type)
+  (:method :around (value var body type)
+    (let ((*runtime-translator-form*
+           (%expand-type-to-foreign-dyn value var body type)))
+      (call-next-method)))  
+  (:method (value var body type)
+    ;; If COMPUTE-APPLICABLE-METHODS only finds one method it's
+    ;; the default one meaning that there is no to-foreign expander
+    ;; therefore we return *RUNTIME-TRANSLATOR-FORM* instead.
+    (if (specializedp #'expand-type-to-foreign value type)
+        `(let ((,var ,(expand-type-to-foreign value type)))
+           , at body)
+        *runtime-translator-form*)))
+
+(defgeneric expand-type-to-foreign (value type)
+  (:method :around (value type)
+    (let ((*runtime-translator-form* (%expand-type-to-foreign value type)))
+      (call-next-method)))
+  (:method (value type)
+    (declare (ignore value type))
+    *runtime-translator-form*))
+
+(defgeneric expand-type-from-foreign (value type)
+  (:method :around (value type)
+    (let ((*runtime-translator-form* (%expand-type-from-foreign value type)))
+      (call-next-method)))
+  (:method (value type)
+    (declare (ignore value type))
+    *runtime-translator-form*))
+
+(defgeneric expand-to-foreign-dyn (value var body type)
+  (:method (value var body type)
+    (declare (ignore value var body type))
+    *runtime-translator-form*))
+(defgeneric expand-to-foreign (value type)
+  (:method (value type)
+    (declare (ignore value type))
+    *runtime-translator-form*))
+(defgeneric expand-from-foreign (value type)
+  (:method (value type)
+    (declare (ignore value type))
+    *runtime-translator-form*))
+
+(defmethod expand-type-to-foreign-dyn (value var body (type foreign-typedef))
+  (if (or (specializedp #'expand-to-foreign-dyn
+                        value var body (name type))
+          (not (specializedp #'expand-to-foreign value (name type))))
+      (expand-to-foreign-dyn value var body (name type))
+      ;; If there is to-foreign _expansion_, but not to-foreign-dyn
+      ;; expansion, we use that.
+      `(let ((,var ,(expand-type-to-foreign value type)))
+        , at body)))
+
+(defmethod expand-type-to-foreign (value (type foreign-typedef))
+  (expand-to-foreign value (name type)))
+
+(defmethod expand-type-from-foreign (value (type foreign-typedef))
+  (expand-from-foreign value (name type)))
+
+;;; User interface for converting values from/to foreign using the
+;;; type translators. Something doesn't feel right about this, makes
+;;; me want to just export PARSE-TYPE...
+
+(defun convert-to-foreign (value type)
+  (translate-type-to-foreign value (parse-type type)))
+
+(define-compiler-macro convert-to-foreign (value type)
+  (if (constantp type)
+      (expand-type-to-foreign value (parse-type (eval type)))
+      `(translate-type-to-foreign ,value (parse-type ,type))))
+
+(defun convert-from-foreign (value type)
+  (translate-type-from-foreign value (parse-type type)))
+
+(define-compiler-macro convert-from-foreign (value type)
+  (if (constantp type)
+      (expand-type-from-foreign value (parse-type (eval type)))
+      `(translate-type-from-foreign ,value (parse-type ,type))))
+
+(defun free-converted-object (value type param)
+  (free-type-translated-object value type param))

Added: branches/xml-class-rework/thirdparty/cffi/src/enum.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/src/enum.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/src/enum.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,196 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; enum.lisp --- Defining foreign constants as Lisp keywords.
+;;;
+;;; Copyright (C) 2005, James Bielman   
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+(in-package #:cffi)
+
+;;;# Foreign Constants as Lisp Keywords
+;;;
+;;; This module defines the DEFCENUM macro, which provides an
+;;; interface for defining a type and associating a set of integer
+;;; constants with keyword symbols for that type.
+;;;
+;;; The keywords are automatically translated to the appropriate
+;;; constant for the type by a type translator when passed as
+;;; arguments or a return value to a foreign function.
+
+(defclass foreign-enum (foreign-type-alias)
+  ((keyword-values
+    :initform (make-hash-table :test 'eq)
+    :reader keyword-values)
+   (value-keywords
+    :initform (make-hash-table)
+    :reader value-keywords))
+  (:documentation "Describes a foreign enumerated type."))
+
+(defun make-foreign-enum (type-name base-type values)
+  "Makes a new instance of the foreign-enum class."
+  (let ((type (make-instance 'foreign-enum :name type-name
+                             :actual-type (parse-type base-type)))
+        (default-value 0))
+    (dolist (pair values)
+      (destructuring-bind (keyword &optional (value default-value))
+          (mklist pair)
+        (check-type keyword keyword)
+        (check-type value integer)
+        (if (gethash keyword (keyword-values type))
+            (error "A foreign enum cannot contain duplicate keywords: ~S."
+                   keyword)
+            (setf (gethash keyword (keyword-values type)) value))
+        ;; This completely arbitrary behaviour: we keep the last we
+        ;; value->keyword mapping. I suppose the opposite would be just as
+        ;; good (keeping the first). Returning a list with all the keywords
+        ;; might be a solution too? Suggestions welcome. --luis
+        (setf (gethash value (value-keywords type)) keyword)
+        (setq default-value (1+ value))))
+    type))
+
+(defmacro defcenum (name-and-options &body enum-list)
+  "Define an foreign enumerated type."
+  (discard-docstring enum-list)
+  (destructuring-bind (name &optional (base-type :int))
+      (mklist name-and-options)
+    `(eval-when (:compile-toplevel :load-toplevel :execute)
+       (notice-foreign-type
+        (make-foreign-enum ',name ',base-type ',enum-list)))))
+
+;;; These [four] functions could be good canditates for compiler macros
+;;; when the value or keyword is constant.  I am not going to bother
+;;; until someone has a serious performance need to do so though. --jamesjb
+(defun %foreign-enum-value (type keyword &key errorp)
+  (check-type keyword keyword)
+  (or (gethash keyword (keyword-values type))
+      (when errorp
+        (error "~S is not defined as a keyword for enum type ~S."
+               keyword type))))
+
+(defun foreign-enum-value (type keyword &key (errorp t))
+  "Convert a KEYWORD into an integer according to the enum TYPE."
+  (let ((type-obj (parse-type type)))
+    (if (not (typep type-obj 'foreign-enum))
+      (error "~S is not a foreign enum type." type)
+      (%foreign-enum-value type-obj keyword :errorp errorp))))
+
+(defun %foreign-enum-keyword (type value &key errorp)
+  (check-type value integer)
+  (or (gethash value (value-keywords type))
+      (when errorp
+        (error "~S is not defined as a value for enum type ~S."
+               value type))))
+
+(defun foreign-enum-keyword (type value &key (errorp t))
+  "Convert an integer VALUE into a keyword according to the enum TYPE."
+  (let ((type-obj (parse-type type)))
+    (if (not (typep type-obj 'foreign-enum))
+        (error "~S is not a foreign enum type." type)
+        (%foreign-enum-keyword type-obj value :errorp errorp))))
+
+(defmethod translate-type-to-foreign (value (type foreign-enum))
+  (if (keywordp value)
+      (%foreign-enum-value type value)
+      value))
+
+(defmethod translate-type-from-foreign (value (type foreign-enum))
+  (%foreign-enum-keyword type value))
+
+;;;# Foreign Bitfields as Lisp keywords
+;;;
+;;; DEFBITFIELD is an abstraction similar to the one provided by DEFCENUM.
+;;; With some changes to DEFCENUM, this could certainly be implemented on
+;;; top of it.
+
+(defclass foreign-bitfield (foreign-type-alias)
+  ((symbol-values
+    :initform (make-hash-table :test 'eq)
+    :reader symbol-values)
+   (value-symbols
+    :initform (make-hash-table)
+    :reader value-symbols))
+  (:documentation "Describes a foreign bitfield type."))
+
+(defun make-foreign-bitfield (type-name base-type values)
+  "Makes a new instance of the foreign-bitfield class."
+  (let ((type (make-instance 'foreign-bitfield :name type-name
+                             :actual-type (parse-type base-type))))
+    (dolist (pair values)
+      (destructuring-bind (symbol value) pair
+        (check-type value integer)
+        (check-type symbol symbol)
+        (if (gethash symbol (symbol-values type))
+            (error "A foreign bitfield cannot contain duplicate symbols: ~S."
+                   symbol)
+            (setf (gethash symbol (symbol-values type)) value))
+        (push symbol (gethash value (value-symbols type)))))
+    type))
+
+(defmacro defbitfield (name-and-options &body masks)
+  "Define an foreign enumerated type."
+  (discard-docstring masks)
+  (destructuring-bind (name &optional (base-type :int))
+      (mklist name-and-options)
+    `(eval-when (:compile-toplevel :load-toplevel :execute)
+       (notice-foreign-type
+        (make-foreign-bitfield ',name ',base-type ',masks)))))
+
+(defun %foreign-bitfield-value (type symbols)
+  (let ((bitfield 0))
+    (dolist (symbol symbols)
+      (check-type symbol symbol)
+      (let ((value (or (gethash symbol (symbol-values type))
+                       (error "~S is not a valid symbol for bitfield type ~S."
+                              symbol type))))
+        (setq bitfield (logior bitfield value))))
+    bitfield))
+
+(defun foreign-bitfield-value (type symbols)
+  "Convert a list of symbols into an integer according to the TYPE bitfield."
+  (let ((type-obj (parse-type type)))
+    (if (not (typep type-obj 'foreign-bitfield))
+      (error "~S is not a foreign bitfield type." type)
+      (%foreign-bitfield-value type-obj symbols))))
+
+(defun %foreign-bitfield-symbols (type value)
+  (check-type value integer)
+  (loop for mask being the hash-keys in (value-symbols type)
+            using (hash-value symbols)
+        when (= (logand value mask) mask)
+        append symbols))
+
+(defun foreign-bitfield-symbols (type value)
+  "Convert an integer VALUE into a list of matching symbols according to
+the bitfield TYPE."
+  (let ((type-obj (parse-type type)))
+    (if (not (typep type-obj 'foreign-bitfield))
+        (error "~S is not a foreign bitfield type." type)
+        (%foreign-bitfield-symbols type-obj value))))
+
+(defmethod translate-type-to-foreign (value (type foreign-bitfield))
+  (if (integerp value)
+      value
+      (%foreign-bitfield-value type (mklist value))))
+
+(defmethod translate-type-from-foreign (value (type foreign-bitfield))
+  (%foreign-bitfield-symbols type value))
\ No newline at end of file

Added: branches/xml-class-rework/thirdparty/cffi/src/features.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/src/features.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/src/features.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,56 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; features.lisp --- CFFI-specific features.
+;;;
+;;; Copyright (C) 2006, Luis Oliveira  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+(in-package #:cl-user)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (pushnew :cffi *features*))
+
+(defpackage #:cffi-features
+  (:export
+   ;; Features related to the CFFI-SYS backend.
+   ;; Why no-*? This reflects the hope that these symbols will
+   ;; go away completely and all lisps support long-long's and
+   ;; the foreign-funcall primitive.
+   #:no-long-long
+   #:no-foreign-funcall
+
+   ;; Only SCL support long-double...
+   ;;#:no-long-double
+   
+   ;; Features related to the operating system.
+   ;; Currently only these are pushed to *features*, more should be added.
+   #:darwin
+   #:unix
+   #:windows
+
+   ;; Features related to the processor.
+   ;; Currently only these are pushed to *features*, more should be added.
+   #:ppc32
+   #:x86
+   #:x86-64
+   ))

Added: branches/xml-class-rework/thirdparty/cffi/src/foreign-vars.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/src/foreign-vars.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/src/foreign-vars.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,84 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; foreign-vars.lisp --- High-level interface to foreign globals.
+;;;
+;;; Copyright (C) 2005, Luis Oliveira  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+(in-package #:cffi)
+
+;;;# Accessing Foreign Globals
+
+(defun lisp-var-name (name)
+  "Return the Lisp symbol for foreign var NAME."
+  (etypecase name
+    (list (second name))
+    (string (intern (format nil "*~A*" (canonicalize-symbol-name-case
+                                        (substitute #\- #\_ name)))))))
+
+(defun foreign-var-name (name)
+  "Return the foreign var name of NAME."
+  (etypecase name
+    (list (first name))
+    (string name)
+    (symbol
+     (let ((sn (substitute #\_ #\- (string-downcase (symbol-name name)))))
+       (if (eql (char sn 0) #\*)
+           ;; remove asterisks around the var name
+           (subseq sn 1 (1- (length sn)))
+           sn)))))
+
+(defun get-var-pointer (symbol)
+  "Return a pointer to the foreign global variable relative to SYMBOL."
+  (foreign-symbol-pointer (get symbol 'foreign-var-name)))
+
+(defun foreign-symbol-pointer-or-lose (foreign-name)
+  "Like foreign-symbol-ptr but throws an error instead of
+returning nil when foreign-name is not found."
+  (or (foreign-symbol-pointer foreign-name)
+      (error "Trying to access undefined foreign variable ~S." foreign-name)))
+
+(defmacro defcvar (name type &key read-only)
+  "Define a foreign global variable."
+  (let* ((lisp-name (lisp-var-name name))
+         (foreign-name (foreign-var-name name))
+         (fn (symbolicate '#:%var-accessor- lisp-name)))
+    (when (aggregatep (parse-type type)) ; we can't really setf an aggregate
+      (setq read-only t))                ; type, at least not yet...
+    `(progn
+       ;; Save foreign-name for posterior access by get-var-pointer
+       (setf (get ',lisp-name 'foreign-var-name) ,foreign-name)
+       ;; Getter
+       (defun ,fn ()
+         (mem-ref (foreign-symbol-pointer-or-lose ,foreign-name) ',type)) 
+       ;; Setter
+       (defun (setf ,fn) (value)
+         ,(if read-only '(declare (ignore value)) (values))
+         ,(if read-only
+              `(error ,(format nil "Trying to modify read-only foreign var: ~A."
+                               lisp-name))
+              `(setf (mem-ref (foreign-symbol-pointer-or-lose ,foreign-name)
+                              ',type)
+                     value)))
+       ;; Symbol macro
+       (define-symbol-macro ,lisp-name (,fn)))))

Added: branches/xml-class-rework/thirdparty/cffi/src/functions.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/src/functions.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/src/functions.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,223 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; functions.lisp --- High-level interface to foreign functions.
+;;;
+;;; Copyright (C) 2005, James Bielman  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+(in-package #:cffi)
+
+;;;# Calling Foreign Functions
+;;;
+;;; FOREIGN-FUNCALL is the main primitive for calling foreign
+;;; functions.  It converts each argument based on the installed
+;;; translators for its type, then passes the resulting list to
+;;; CFFI-SYS:%FOREIGN-FUNCALL.
+;;;
+;;; For implementation-specific reasons, DEFCFUN doesn't use
+;;; FOREIGN-FUNCALL directly and might use something else
+;;; (passed to TRANSLATE-OBJECTS as the CALL argument) instead
+;;; of CFFI-SYS:%FOREIGN-FUNCALL to call the foreign-function.
+
+(defun translate-objects (syms args types rettype call-form)
+  "Helper function for FOREIGN-FUNCALL and DEFCFUN."
+  (if (null args)
+      (expand-type-from-foreign call-form (parse-type rettype))
+      (expand-type-to-foreign-dyn
+       (car args) (car syms)
+       (list (translate-objects (cdr syms) (cdr args)
+                                (cdr types) rettype call-form))
+       (parse-type (car types)))))
+
+(defun parse-args-and-types (args)
+  "Returns 4 values. Types, canonicalized types, args and return type."
+  (let ((return-type :void))
+    (loop for (type arg) on args by #'cddr
+          if arg collect type into types
+             and collect (canonicalize-foreign-type type) into ctypes
+             and collect arg into fargs
+          else do (setf return-type type)
+          finally (return (values types ctypes fargs return-type)))))
+
+(defmacro foreign-funcall (name-or-pointer &rest args)
+  "Wrapper around %FOREIGN-FUNCALL(-POINTER) that translates its arguments."
+  (multiple-value-bind (types ctypes fargs rettype)
+      (parse-args-and-types args)
+    (let ((syms (make-gensym-list (length fargs))))
+      (translate-objects
+       syms fargs types rettype
+       `(,(if (stringp name-or-pointer)
+              '%foreign-funcall
+              '%foreign-funcall-pointer)
+          ,name-or-pointer ,@(mapcan #'list ctypes syms)
+          ,(canonicalize-foreign-type rettype))))))
+
+(defun promote-varargs-type (builtin-type)
+  "Default argument promotions."
+  (case builtin-type
+    (:float :double)
+    ((:char :short) :int)
+    ((:unsigned-char :unsigned-short) :unsigned-int)
+    (t builtin-type)))
+
+;;; ATM, the only difference between this macro and FOREIGN-FUNCALL is that
+;;; it does argument promotion for that variadic argument. This could be useful
+;;; to call an hypothetical %foreign-funcall-varargs on some hypothetical lisp
+;;; on an hypothetical platform that has different calling conventions for
+;;; varargs functions. :-)
+(defmacro foreign-funcall-varargs (name-or-pointer fixed-args &rest varargs)
+  "Wrapper around %FOREIGN-FUNCALL(-POINTER) that translates its arguments
+and does type promotion for the variadic arguments."
+  (multiple-value-bind (fixed-types fixed-ctypes fixed-fargs)
+      (parse-args-and-types fixed-args)
+    (multiple-value-bind (varargs-types varargs-ctypes varargs-fargs rettype)
+        (parse-args-and-types varargs)
+      (let ((fixed-syms (make-gensym-list (length fixed-fargs)))
+            (varargs-syms (make-gensym-list (length varargs-fargs))))
+        (translate-objects
+         (append fixed-syms varargs-syms) (append fixed-fargs varargs-fargs)
+         (append fixed-types varargs-types) rettype
+         `(,(if (stringp name-or-pointer)
+                '%foreign-funcall
+                '%foreign-funcall-pointer)
+            ,name-or-pointer
+            ,@(mapcan #'list
+                      (nconc fixed-ctypes
+                             (mapcar #'promote-varargs-type varargs-ctypes))
+                      (append fixed-syms
+                              (loop for sym in varargs-syms
+                                    and type in varargs-ctypes
+                                    if (eq type :float)
+                                    collect `(float ,sym 1.0d0)
+                                    else collect sym)))
+            ,(canonicalize-foreign-type rettype)))))))
+
+;;;# Defining Foreign Functions
+;;;
+;;; The DEFCFUN macro provides a declarative interface for defining
+;;; Lisp functions that call foreign functions.
+
+(defun lisp-function-name (name)
+  "Return the Lisp function name for foreign function NAME."
+  (etypecase name
+    (list (second name))
+    (string (intern (canonicalize-symbol-name-case (substitute #\- #\_ name))))
+    (symbol name)))
+
+(defun foreign-function-name (name)
+  "Return the foreign function name of NAME."
+  (etypecase name
+    (list (first name))
+    (string name)
+    (symbol (substitute #\_ #\- (string-downcase (symbol-name name))))))
+
+;; If cffi-sys doesn't provide a defcfun-helper-forms,
+;; we define one that uses %foreign-funcall.
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (unless (fboundp 'defcfun-helper-forms)
+    (defun defcfun-helper-forms (name lisp-name rettype args types)
+      (declare (ignore lisp-name))
+      (values
+       '()
+       `(%foreign-funcall ,name ,@(mapcan #'list types args) ,rettype)))))
+
+(defun %defcfun (lisp-name foreign-name return-type args)
+  (let ((arg-names (mapcar #'car args))
+        (arg-types (mapcar #'cadr args))
+        (syms (make-gensym-list (length args))))
+    (multiple-value-bind (prelude caller)
+        (defcfun-helper-forms
+          foreign-name lisp-name (canonicalize-foreign-type return-type)
+          syms (mapcar #'canonicalize-foreign-type arg-types))
+      `(progn
+         ,prelude
+         (defun ,lisp-name ,arg-names
+           ,(translate-objects
+             syms arg-names arg-types return-type caller))))))
+
+(defun %defcfun-varargs (lisp-name foreign-name return-type args)
+  (with-unique-names (varargs)
+    (let ((arg-names (mapcar #'car args)))
+      `(defmacro ,lisp-name (, at arg-names &rest ,varargs)
+         `(foreign-funcall-varargs
+           ,',foreign-name
+           ,,`(list ,@(loop for (name type) in args
+                            collect type collect name))
+           ,@,varargs
+           ,',return-type)))))
+
+;;; If we find a &REST token at the end of ARGS, it's a varargs function
+;;; therefore we define a lisp macro using %DEFCFUN-VARARGS instead of a
+;;; lisp macro with %DEFCFUN as we would otherwise do.
+(defmacro defcfun (name return-type &body args)
+  "Defines a Lisp function that calls a foreign function."
+  (discard-docstring args)
+  (let ((lisp-name (lisp-function-name name))
+        (foreign-name (foreign-function-name name)))
+    (if (eq (car (last args)) '&rest)   ; probably should use STRING=
+        (%defcfun-varargs lisp-name foreign-name return-type (butlast args))
+        (%defcfun lisp-name foreign-name return-type args))))
+
+;;;# Defining Callbacks
+
+(defun inverse-translate-objects (args ignored-args types rettype call)
+  "Helper function for DEFCALLBACK."
+  (labels ((rec (args types)
+             (cond ((null args)
+                    (expand-type-to-foreign call (parse-type rettype)))
+                   ;; Don't apply translations for arguments that were
+                   ;; declared ignored in order to avoid warnings.
+                   ((not (member (car args) ignored-args))
+                    `(let ((,(car args) ,(expand-type-from-foreign
+                                          (car args) (parse-type (car types)))))
+                       ,(rec (cdr args) (cdr types))))
+                   (t (rec (cdr args) (cdr types)))))) 
+    (rec args types)))
+
+(defun collect-ignored-args (declarations)
+  (loop for declaration in declarations
+        append (loop for decl in (cdr declaration)
+                     when (eq (car decl) 'cl:ignore)
+                     append (cdr decl))))
+
+(defmacro defcallback (name return-type args &body body)
+  (multiple-value-bind (body docstring declarations)
+      (parse-body body)
+    (declare (ignore docstring))
+    (let ((arg-names (mapcar #'car args))
+          (arg-types (mapcar #'cadr args)))
+      `(progn
+         (%defcallback ,name ,(canonicalize-foreign-type return-type)
+             ,arg-names ,(mapcar #'canonicalize-foreign-type arg-types)
+           , at declarations
+           ,(inverse-translate-objects
+             arg-names (collect-ignored-args declarations) arg-types
+             return-type `(block ,name , at body)))
+         ',name))))
+
+(declaim (inline get-callback))
+(defun get-callback (symbol)
+  (%callback symbol))
+
+(defmacro callback (name)
+  `(%callback ',name))

Added: branches/xml-class-rework/thirdparty/cffi/src/libraries.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/src/libraries.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/src/libraries.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,257 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; libraries.lisp --- Finding and loading foreign libraries.
+;;;
+;;; Copyright (C) 2005, James Bielman  
+;;; Copyright (C) 2006, Luis Oliveira  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+(in-package #:cffi)
+
+;;;# Finding Foreign Libraries
+;;;
+;;; We offer two ways for the user of a CFFI library to define
+;;; his/her own library directories: *FOREIGN-LIBRARY-DIRECTORIES*
+;;; for regular libraries and *DARWIN-FRAMEWORK-DIRECTORIES* for
+;;; Darwin frameworks.
+;;;
+;;; These two special variables behave similarly to
+;;; ASDF:*CENTRAL-REGISTRY* as its arguments are evaluated before
+;;; being used. We used our MINI-EVAL instead of the full-blown EVAL
+;;; though.
+;;;
+;;; Only after failing to find a library through the normal ways
+;;; (eg: on Linux LD_LIBRARY_PATH, /etc/ld.so.cache, /usr/lib/, /lib)
+;;; do we try to find the library ourselves.
+
+(defvar *foreign-library-directories* '()
+  "List onto which user-defined library paths can be pushed.")
+
+(defvar *darwin-framework-directories*
+  '((merge-pathnames #p"Library/Frameworks/" (user-homedir-pathname))
+    #p"/Library/Frameworks/"
+    #p"/System/Library/Frameworks/")
+  "List of directories where Frameworks are searched for.")
+
+(defun mini-eval (form)
+  "Simple EVAL-like function to evaluate the elements of
+*FOREIGN-LIBRARY-DIRECTORIES* and *DARWIN-FRAMEWORK-DIRECTORIES*."
+  (typecase form
+    (cons (apply (car form) (mapcar #'mini-eval (cdr form))))
+    (symbol (symbol-value form))
+    (t form)))
+
+(defun find-file (path directories)
+  "Searches for PATH in a list of DIRECTORIES and returns the first it finds."
+  (some (lambda (directory) (probe-file (merge-pathnames path directory)))
+        directories))
+  
+(defun find-darwin-framework (framework-name)
+  "Searches for FRAMEWORK-NAME in *DARWIN-FRAMEWORK-DIRECTORIES*."
+  (dolist (framework-directory *darwin-framework-directories*)
+    (let ((path (make-pathname
+                 :name framework-name
+                 :directory
+                 (append (pathname-directory (mini-eval framework-directory))
+                         (list (format nil "~A.framework" framework-name))))))
+      (when (probe-file path)
+        (return-from find-darwin-framework path)))))
+
+;;;# Defining Foreign Libraries
+;;;
+;;; Foreign libraries can be defined using the
+;;; DEFINE-FOREIGN-LIBRARY macro. Example usage:
+;;;
+;;; (define-foreign-library opengl
+;;;   (:darwin  (:framework "OpenGL"))
+;;;   (:unix    (:alternatives "libGL.so" "libGL.so.1"
+;;;                            #p"/myhome/mylibGL.so"))
+;;;   (:windows "opengl32.dll")
+;;;   ;; a hypothetical example of a particular platform
+;;;   ;; where the OpenGL library is split in two.
+;;;   ((:and :some-system :some-cpu) "libGL-support.lib" "libGL-main.lib")
+;;;   ;; if no other clauses apply, this one will and a type will be
+;;;   ;; automagically appended to the name passed to :default
+;;;   (t (:default "libGL")))
+;;;
+;;; This information is stored in the *FOREIGN-LIBRARIES* hashtable
+;;; and when the library is loaded through LOAD-FOREIGN-LIBRARY (usually
+;;; indirectly through the USE-FOREIGN-LIBRARY macro) the first clause
+;;; that returns true when passed to CFFI-FEATURE-P is processed.
+
+(defvar *foreign-libraries* (make-hash-table :test 'eq)
+  "Hashtable of defined libraries.")
+
+(defun get-foreign-library (name)
+  "Look up a library by NAME, signalling an error if not found."
+  (or (gethash name *foreign-libraries*)
+      (error "Undefined foreign library: ~S" name)))
+
+(defun (setf get-foreign-library) (value name)
+  (setf (gethash name *foreign-libraries*) value))
+
+(defmacro define-foreign-library (name &body pairs)
+  "Defines a foreign library NAME that can be posteriorly used with
+the USE-FOREIGN-LIBRARY macro."
+  `(progn (setf (get-foreign-library ',name) ',pairs)
+          ',name))
+
+(defun cffi-feature-p (feature-expression)
+  "Matches a FEATURE-EXPRESSION against the symbols in *FEATURES*
+that belong to the CFFI-FEATURES package only."
+  (when (eql feature-expression t)
+    (return-from cffi-feature-p t))
+  (let ((features-package (find-package '#:cffi-features)))
+    (flet ((cffi-feature-eq (name feature-symbol)
+             (and (eq (symbol-package feature-symbol) features-package)
+                  (string= name (symbol-name feature-symbol)))))
+      (etypecase feature-expression
+        (symbol
+         (not (null (member (symbol-name feature-expression) *features*
+                            :test #'cffi-feature-eq))))
+        (cons
+         (ecase (first feature-expression)
+           (:and (every #'cffi-feature-p (rest feature-expression)))
+           (:or  (some #'cffi-feature-p (rest feature-expression)))
+           (:not (not (cffi-feature-p (cadr feature-expression))))))))))
+
+;;;# LOAD-FOREIGN-LIBRARY-ERROR condition
+;;;
+;;; The various helper functions that load foreign libraries
+;;; can signal this error when something goes wrong. We ignore
+;;; the host's error. We should probably reuse its error message
+;;; but they're usually meaningless.
+
+(define-condition load-foreign-library-error (error)
+  ((text :initarg :text :reader text))
+  (:report (lambda (condition stream)
+             (write-string (text condition) stream))))
+
+(defun read-new-value ()
+  (format t "~&Enter a new value (unevaluated): ")
+  (force-output)
+  (read))
+
+;;; The helper library loading functions will use this function
+;;; to signal a LOAD-FOREIGN-LIBRARY-ERROR and offer the user a
+;;; couple of restarts.
+(defun handle-load-foreign-library-error (argument control &rest arguments)
+  (restart-case (error 'load-foreign-library-error
+                       :text (format nil "~?" control arguments))
+    (retry ()
+      :report "Try loading the foreign library again."
+      (load-foreign-library argument))
+    (use-value (new-library)
+      :report "Use another library instead."
+      :interactive read-new-value
+      (load-foreign-library new-library))))
+
+;;;# Loading Foreign Libraries
+
+(defun load-darwin-framework (framework-name)
+  "Tries to find and load a darwin framework in one of the directories
+in *DARWIN-FRAMEWORK-DIRECTORIES*. If unable to find FRAMEWORK-NAME,
+it signals a LOAD-FOREIGN-LIBRARY-ERROR."
+  (let ((framework (find-darwin-framework framework-name)))
+    (if framework
+        (load-foreign-library framework)
+        (handle-load-foreign-library-error
+         (cons :framework framework-name)
+         "Unable to find framework: ~A" framework-name))))
+
+(defun load-foreign-library-name (name)
+  "Tries to load NAME using %LOAD-FOREIGN-LIBRARY which should try and
+find it using the OS's usual methods. If that fails we try to find it
+ourselves."
+  (or (ignore-errors (%load-foreign-library name))
+      (let ((file (find-file name *foreign-library-directories*)))
+        (when file
+          (%load-foreign-library (namestring file))))
+      ;; couldn't load it directly or find it...
+      (handle-load-foreign-library-error
+       name "Unable to load foreign library: ~A" name)))
+
+(defun try-foreign-library-alternatives (library-list)
+  "Goes through a list of alternatives and only signals an error when
+none of alternatives were successfully loaded."
+  (or (some (lambda (lib) (ignore-errors (load-foreign-library lib)))
+            library-list)
+      (handle-load-foreign-library-error
+       (cons :or library-list)
+       "Unable to load any of the alternatives:~%   ~S" library-list)))
+
+(defparameter *cffi-feature-suffix-map*
+  '((cffi-features:windows . ".dll")
+    (cffi-features:darwin . ".dylib")
+    (cffi-features:unix . ".so"))
+  "Mapping of OS feature keywords to shared library suffixes.")
+
+(defun default-library-suffix ()
+  "Return a string to use as default library suffix based on the
+operating system.  This is used to implement the :DEFAULT option.
+This will need to be extended as we test on more OSes."
+  (loop for (feature . suffix) in *cffi-feature-suffix-map*
+        when (cffi-feature-p feature)
+        do (return-from default-library-suffix suffix))
+  (error "Unable to determine the default library suffix on this OS."))
+
+(defun load-foreign-library (library)
+  "Loads a foreign LIBRARY which can be a symbol denoting a library defined
+through DEFINE-FOREIGN-LIBRARY; a pathname or string in which case we try to
+load it directly first then search for it in *FOREIGN-LIBRARY-DIRECTORIES*;
+or finally list: either (:or lib1 lib2) or (:framework )."
+  (etypecase library
+    (symbol
+     (dolist (library-description (get-foreign-library library))
+       (when (cffi-feature-p (first library-description))
+         (dolist (lib (rest library-description))
+           (load-foreign-library lib))
+         (return-from load-foreign-library t))))
+    (string
+     (load-foreign-library-name library))
+    (pathname
+     (load-foreign-library-name (namestring library)))
+    (cons
+     (ecase (first library)
+       (:framework (load-darwin-framework (second library)))
+       (:default
+        (unless (stringp (second library))
+          (error "Argument to :DEFAULT must be a string."))
+        (load-foreign-library
+         (concatenate 'string (second library) (default-library-suffix))))
+       (:or (try-foreign-library-alternatives (rest library)))))))
+
+(defmacro use-foreign-library (name)
+  `(load-foreign-library ',name))
+
+;;;# Closing Foreign Libraries
+;;;
+;;; FIXME: LOAD-FOREIGN-LIBRARY should probably keep track of what
+;;; libraries it managed to open and CLOSE-FOREIGN-LIBRARY would then
+;;; take a look at that. So, for now, this function is unexported.
+
+(defun close-foreign-library (name)
+  "Closes a foreign library NAME."
+  (%close-foreign-library (etypecase name
+                            (pathname (namestring name))
+                            (string name))))
\ No newline at end of file

Added: branches/xml-class-rework/thirdparty/cffi/src/package.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/src/package.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/src/package.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,113 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; package.lisp --- Package definition for CFFI.
+;;;
+;;; Copyright (C) 2005, James Bielman  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+(in-package #:cl-user)
+
+(defpackage #:cffi
+  (:use #:common-lisp #:cffi-sys #:cffi-utils)
+  (:export
+   ;; Primitive pointer operations.
+   #:foreign-free
+   #:foreign-alloc
+   #:mem-aref
+   #:mem-ref
+   #:pointerp
+   #:pointer-eq
+   #:null-pointer
+   #:null-pointer-p
+   #:inc-pointer
+   #:with-foreign-pointer
+   #:make-pointer
+   #:pointer-address
+   
+   ;; Shareable vectors.
+   #:make-shareable-vector
+   #:with-pointer-to-vector-data
+
+   ;; Foreign string operations.
+   #:foreign-string-alloc
+   #:foreign-string-free
+   #:foreign-string-to-lisp
+   #:lisp-string-to-foreign
+   #:with-foreign-string
+   #:with-foreign-pointer-as-string
+
+   ;; Foreign function operations.
+   #:defcfun
+   #:foreign-funcall
+
+   ;; Foreign library operations.
+   #:*foreign-library-directories*
+   #:*darwin-framework-directories*
+   #:define-foreign-library
+   #:load-foreign-library
+   #:load-foreign-library-error
+   #:use-foreign-library
+   ;#:close-foreign-library 
+
+   ;; Callbacks.
+   #:callback
+   #:get-callback
+   #:defcallback
+
+   ;; Foreign type operations.
+   #:defcstruct
+   #:defcunion
+   #:defctype
+   #:defcenum
+   #:defbitfield
+   #:define-foreign-type
+   #:foreign-enum-keyword
+   #:foreign-enum-value
+   #:foreign-bitfield-symbols
+   #:foreign-bitfield-value
+   #:foreign-slot-pointer
+   #:foreign-slot-value
+   #:foreign-slot-offset
+   #:foreign-slot-names
+   #:foreign-type-alignment
+   #:foreign-type-size
+   #:with-foreign-object
+   #:with-foreign-objects
+   #:with-foreign-slots
+   #:convert-to-foreign
+   #:convert-from-foreign
+   #:free-converted-object
+
+   ;; Extensible foreign type operations.
+   #:translate-to-foreign
+   #:translate-from-foreign
+   #:free-translated-object
+   #:expand-to-foreign-dyn
+   #:expand-to-foreign
+   #:expand-from-foreign
+
+   ;; Foreign globals.
+   #:defcvar
+   #:get-var-pointer
+   #:foreign-symbol-pointer
+   ))

Added: branches/xml-class-rework/thirdparty/cffi/src/strings.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/src/strings.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/src/strings.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,140 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; strings.lisp --- Operations on foreign strings.
+;;;
+;;; Copyright (C) 2005, James Bielman  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+(in-package #:cffi)
+
+;;;# Foreign String Conversion
+;;;
+;;; Functions for converting NULL-terminated C-strings to Lisp strings
+;;; and vice versa.  Currently this is blithely ignorant of encoding
+;;; and assumes characters can fit in 8 bits.
+
+(defun lisp-string-to-foreign (string ptr size)
+  "Copy at most SIZE-1 characters from a Lisp STRING to PTR.
+The foreign string will be null-terminated."
+  (decf size)
+  (loop with i = 0 for char across string
+        while (< i size)
+        do (%mem-set (char-code char) ptr :unsigned-char (post-incf i))
+        finally (%mem-set 0 ptr :unsigned-char i)))
+
+(defun foreign-string-to-lisp (ptr &optional (size most-positive-fixnum)
+                               (null-terminated-p t))
+  "Copy at most SIZE characters from PTR into a Lisp string.
+If PTR is a null pointer, returns nil."
+  (unless (null-pointer-p ptr)
+    (with-output-to-string (s)
+      (loop for i fixnum from 0 below size
+            for code = (mem-ref ptr :unsigned-char i)
+            until (and null-terminated-p (zerop code))
+            do (write-char (code-char code) s)))))
+
+;;;# Using Foreign Strings
+
+(defun foreign-string-alloc (string)
+  "Allocate a foreign string containing Lisp string STRING.
+The string must be freed with FOREIGN-STRING-FREE."
+  (check-type string string)
+  (let* ((length (1+ (length string)))
+         (ptr (foreign-alloc :char :count length)))
+    (lisp-string-to-foreign string ptr length)
+    ptr))
+
+(defun foreign-string-free (ptr)
+  "Free a foreign string allocated by FOREIGN-STRING-ALLOC."
+  (foreign-free ptr))
+
+(defmacro with-foreign-string ((var lisp-string) &body body)
+  "Bind VAR to a foreign string containing LISP-STRING in BODY."
+  (with-unique-names (str length)
+    `(let* ((,str ,lisp-string)
+            (,length (progn (check-type ,str string)
+                            (1+ (length ,str)))))
+       (with-foreign-pointer (,var ,length)
+         (lisp-string-to-foreign ,str ,var ,length)
+         , at body))))
+
+(defmacro with-foreign-pointer-as-string
+    ((var size &optional size-var) &body body)
+  "Like WITH-FOREIGN-POINTER except VAR as a Lisp string is used as
+the return value of an implicit PROGN around BODY."
+  `(with-foreign-pointer (,var ,size ,size-var)
+     (progn
+       , at body
+       (foreign-string-to-lisp ,var))))
+
+;;;# Automatic Conversion of Foreign Strings
+
+(defctype :string :pointer)
+
+(defmethod translate-to-foreign ((s string) (name (eql :string)))
+  (values (foreign-string-alloc s) t))
+
+(defmethod translate-to-foreign (obj (name (eql :string)))
+  (if (pointerp obj)
+      (values obj nil)
+      (error "~A is not a Lisp string or pointer." obj)))
+
+(defmethod translate-from-foreign (ptr (name (eql :string)))
+  (foreign-string-to-lisp ptr))
+
+(defmethod free-translated-object (ptr (name (eql :string)) free-p)
+  (when free-p
+    (foreign-string-free ptr)))
+
+;;; It'd be pretty nice if returning multiple values from translators
+;;; worked as expected:
+;;;
+;;; (define-type-translator :string :from-c (type value)
+;;;  "Type translator for string arguments."
+;;;  (once-only (value)
+;;;    `(values (foreign-string-to-lisp ,value) ,value)))
+;;;
+;;; For now we'll just define a new type.
+;;;
+;;; Also as this examples shows, it'd be nice to specify
+;;; that we don't want to inherit the from-c translators.
+;;; So we could use (defctype :string+ptr :string) and
+;;; just add the new :from-c translator.
+
+(defctype :string+ptr :pointer)
+
+(defmethod translate-to-foreign ((s string) (name (eql :string+ptr)))
+  (values (foreign-string-alloc s) t))
+
+(defmethod translate-to-foreign (obj (name (eql :string+ptr)))
+  (if (pointerp obj)
+      (values obj nil)
+      (error "~A is not a Lisp string or pointer." obj)))
+
+(defmethod translate-from-foreign (value (name (eql :string+ptr)))
+  (list (foreign-string-to-lisp value) value))
+
+(defmethod free-translated-object (value (name (eql :string+ptr)) free-p)
+  (when free-p
+    (foreign-string-free value)))
+

Added: branches/xml-class-rework/thirdparty/cffi/src/types.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/src/types.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/src/types.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,680 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; types.lisp --- User-defined CFFI types.
+;;;
+;;; Copyright (C) 2005, James Bielman  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+(in-package #:cffi)
+
+;;;# Built-In Types
+
+(define-built-in-foreign-type :char)
+(define-built-in-foreign-type :unsigned-char)
+(define-built-in-foreign-type :short)
+(define-built-in-foreign-type :unsigned-short)
+(define-built-in-foreign-type :int)
+(define-built-in-foreign-type :unsigned-int)
+(define-built-in-foreign-type :long)
+(define-built-in-foreign-type :unsigned-long)
+(define-built-in-foreign-type :float)
+(define-built-in-foreign-type :double)
+(define-built-in-foreign-type :pointer)
+(define-built-in-foreign-type :void)
+
+#-cffi-features:no-long-long
+(progn
+  (define-built-in-foreign-type :long-long)
+  (define-built-in-foreign-type :unsigned-long-long))
+
+;;; When some lisp other than SCL supports :long-double we should
+;;; use #-cffi-features:no-long-double here instead.
+#+(and scl long-float) (define-built-in-foreign-type :long-double)
+
+;;;# Dereferencing Foreign Pointers
+
+(defun mem-ref (ptr type &optional (offset 0))
+  "Return the value of TYPE at OFFSET bytes from PTR. If TYPE is aggregate,
+we don't return its 'value' but a pointer to it, which is PTR itself."
+  (let ((ptype (parse-type type)))
+    (if (aggregatep ptype)
+        (inc-pointer ptr offset)
+        (let ((raw-value (%mem-ref ptr (canonicalize ptype) offset)))
+          (if (translate-p ptype)
+              (translate-type-from-foreign raw-value ptype)
+              raw-value)))))
+
+(define-compiler-macro mem-ref (&whole form ptr type &optional (offset 0))
+  "Compiler macro to open-code MEM-REF when TYPE is constant."
+  (if (constantp type)
+      (let ((parsed-type (parse-type (eval type))))
+        (if (aggregatep parsed-type)
+            `(inc-pointer ,ptr ,offset)
+            (expand-type-from-foreign
+             `(%mem-ref ,ptr ,(canonicalize parsed-type) ,offset)
+             parsed-type)))
+      form))
+
+(defun mem-set (value ptr type &optional (offset 0))
+  "Set the value of TYPE at OFFSET bytes from PTR to VALUE."
+  (let ((ptype (parse-type type)))
+    (%mem-set (if (translate-p ptype)
+                  (translate-type-to-foreign value ptype)
+                  value)
+              ptr (canonicalize ptype) offset)))
+
+(define-setf-expander mem-ref (ptr type &optional (offset 0) &environment env)
+  "SETF expander for MEM-REF that doesn't rebind TYPE.
+This is necessary for the compiler macro on MEM-SET to be able
+to open-code (SETF MEM-REF) forms."
+  (multiple-value-bind (dummies vals newval setter getter)
+      (get-setf-expansion ptr env)
+    (declare (ignore setter newval))
+    ;; if either TYPE or OFFSET are constant, we avoid rebinding them
+    ;; so that the compiler macros on MEM-SET and %MEM-SET work. 
+    (with-unique-names (store type-tmp offset-tmp)
+      (values
+       (append (unless (constantp type)   (list type-tmp))
+               (unless (constantp offset) (list offset-tmp))
+               dummies)
+       (append (unless (constantp type)   (list type))
+               (unless (constantp offset) (list offset))
+               vals)
+       (list store)
+       `(progn
+          (mem-set ,store ,getter
+                   ,@(if (constantp type)   (list type)   (list type-tmp))
+                   ,@(if (constantp offset) (list offset) (list offset-tmp)))
+          ,store)
+       `(mem-ref ,getter
+                 ,@(if (constantp type)   (list type)   (list type-tmp))
+                 ,@(if (constantp offset) (list offset) (list offset-tmp)))))))
+
+(define-compiler-macro mem-set
+    (&whole form value ptr type &optional (offset 0))
+  "Compiler macro to open-code (SETF MEM-REF) when type is constant."
+  (if (constantp type)
+      (let ((parsed-type (parse-type (eval type))))
+        `(%mem-set ,(expand-type-to-foreign value parsed-type) ,ptr
+                   ,(canonicalize parsed-type) ,offset))
+      form))
+
+;;;# Dereferencing Foreign Arrays
+
+(defun mem-aref (ptr type &optional (index 0))
+  "Like MEM-REF except for accessing 1d arrays."
+  (mem-ref ptr type (* index (foreign-type-size type))))
+
+(define-compiler-macro mem-aref (&whole form ptr type &optional (index 0))
+  "Compiler macro to open-code MEM-AREF when TYPE (and eventually INDEX)."
+  (if (constantp type)
+      (if (constantp index)
+          `(mem-ref ,ptr ,type
+                    ,(* (eval index) (foreign-type-size (eval type))))
+          `(mem-ref ,ptr ,type (* ,index ,(foreign-type-size (eval type)))))
+      form))
+
+(define-setf-expander mem-aref (ptr type &optional (index 0) &environment env)
+  "SETF expander for MEM-AREF."
+  (multiple-value-bind (dummies vals newval setter getter)
+      (get-setf-expansion ptr env)
+    (declare (ignore setter newval))
+    ;; we avoid rebinding type and index, if possible (and if type is not
+    ;; constant, we don't bother about the index), so that the compiler macros
+    ;; on MEM-SET or %MEM-SET can work.
+    (with-unique-names (store type-tmp index-tmp)
+      (values
+       (append (unless (constantp type)
+                 (list type-tmp))
+               (unless (and (constantp type) (constantp index))
+                 (list index-tmp))
+               dummies)
+       (append (unless (constantp type)
+                 (list type))
+               (unless (and (constantp type) (constantp index))
+                 (list index))
+               vals)
+       (list store)
+       ;; Here we'll try to calculate the offset from the type and index,
+       ;; or if not possible at least get the type size early.
+       `(progn
+          ,(if (constantp type)
+               (if (constantp index)
+                   `(mem-set ,store ,getter ,type
+                             ,(* (eval index) (foreign-type-size (eval type))))
+                   `(mem-set ,store ,getter ,type
+                             (* ,index-tmp ,(foreign-type-size (eval type)))))
+               `(mem-set ,store ,getter ,type-tmp
+                         (* ,index-tmp (foreign-type-size ,type-tmp))))
+          ,store)
+       `(mem-aref ,getter
+                  ,@(if (constantp type)
+                        (list type)
+                        (list type-tmp))
+                  ,@(if (and (constantp type) (constantp index))
+                        (list index)
+                        (list index-tmp)))))))
+
+;;;# Foreign Structures
+
+;;;## Foreign Structure Slots
+
+(defgeneric foreign-struct-slot-pointer (ptr slot)
+  (:documentation
+   "Get the address of SLOT relative to PTR."))
+
+(defgeneric foreign-struct-slot-pointer-form (ptr slot)
+  (:documentation
+   "Return a form to get the address of SLOT in PTR."))
+
+(defgeneric foreign-struct-slot-value (ptr slot)
+  (:documentation
+   "Return the value of SLOT in structure PTR."))
+
+(defgeneric (setf foreign-struct-slot-value) (value ptr slot)
+  (:documentation
+   "Set the value of a SLOT in structure PTR."))
+
+(defgeneric foreign-struct-slot-value-form (ptr slot)
+  (:documentation
+   "Return a form to get the value of SLOT in struct PTR."))
+
+(defgeneric foreign-struct-slot-set-form (value ptr slot)
+  (:documentation
+   "Return a form to set the value of SLOT in struct PTR."))
+
+(defclass foreign-struct-slot ()
+  ((name   :initarg :name   :reader   slot-name)
+   (offset :initarg :offset :accessor slot-offset)
+   (type   :initarg :type   :accessor slot-type))
+  (:documentation "Base class for simple and aggregate slots."))
+
+(defmethod foreign-struct-slot-pointer (ptr (slot foreign-struct-slot))
+  "Return the address of SLOT relative to PTR."
+  (inc-pointer ptr (slot-offset slot)))
+
+(defmethod foreign-struct-slot-pointer-form (ptr (slot foreign-struct-slot))
+  "Return a form to get the address of SLOT relative to PTR."
+  (let ((offset (slot-offset slot)))
+    (if (zerop offset)
+        ptr
+        `(inc-pointer ,ptr ,offset))))
+
+(defun foreign-slot-names (type)
+  "Returns a list of TYPE's slot names in no particular order."
+  (loop for value being the hash-values
+        in (slots (follow-typedefs (parse-type type)))
+        collect (slot-name value)))
+
+;;;### Simple Slots
+
+(defclass simple-struct-slot (foreign-struct-slot)
+  ()
+  (:documentation "Non-aggregate structure slots."))
+
+(defmethod foreign-struct-slot-value (ptr (slot simple-struct-slot))
+  "Return the value of a simple SLOT from a struct at PTR."
+  (mem-ref ptr (slot-type slot) (slot-offset slot)))
+
+(defmethod foreign-struct-slot-value-form (ptr (slot simple-struct-slot))
+  "Return a form to get the value of a slot from PTR."
+  `(mem-ref ,ptr ',(slot-type slot) ,(slot-offset slot)))
+
+(defmethod (setf foreign-struct-slot-value) (value ptr (slot simple-struct-slot))
+  "Set the value of a simple SLOT to VALUE in PTR."
+  (setf (mem-ref ptr (slot-type slot) (slot-offset slot)) value))
+
+(defmethod foreign-struct-slot-set-form (value ptr (slot simple-struct-slot))
+  "Return a form to set the value of a simple structure slot."
+  `(setf (mem-ref ,ptr ',(slot-type slot) ,(slot-offset slot)) ,value))
+
+;;;### Aggregate Slots
+
+(defclass aggregate-struct-slot (foreign-struct-slot)
+  ((count :initarg :count :accessor slot-count))
+  (:documentation "Aggregate structure slots."))
+
+;;; A case could be made for just returning an error here instead of
+;;; this rather DWIM-ish behavior to return the address.  It would
+;;; complicate being able to chain together slot names when accessing
+;;; slot values in nested structures though.
+(defmethod foreign-struct-slot-value (ptr (slot aggregate-struct-slot))
+  "Return a pointer to SLOT relative to PTR."
+  (foreign-struct-slot-pointer ptr slot))
+
+(defmethod foreign-struct-slot-value-form (ptr (slot aggregate-struct-slot))
+  "Return a form to get the value of SLOT relative to PTR."
+  (foreign-struct-slot-pointer-form ptr slot))
+
+;;; This is definitely an error though.  Eventually, we could define a
+;;; new type of type translator that can convert certain aggregate
+;;; types, notably C strings or arrays of integers.  For now, just error.
+(defmethod (setf foreign-struct-slot-value) (value ptr (slot aggregate-struct-slot))
+  "Signal an error; setting aggregate slot values is forbidden."
+  (declare (ignore value ptr))
+  (error "Cannot set value of aggregate slot ~A." slot))
+
+(defmethod foreign-struct-slot-set-form (value ptr (slot aggregate-struct-slot))
+  "Signal an error; setting aggregate slot values is forbidden."
+  (declare (ignore value ptr))
+  (error "Cannot set value of aggregate slot ~A." slot))
+
+;;;## Defining Foreign Structures
+
+(defun make-struct-slot (name offset type count)
+  "Make the appropriate type of structure slot."
+  ;; If TYPE is an aggregate type or COUNT is >1, create an
+  ;; AGGREGATE-STRUCT-SLOT, otherwise a SIMPLE-STRUCT-SLOT.
+  (if (or (> count 1) (aggregatep (parse-type type)))
+      (make-instance 'aggregate-struct-slot :offset offset :type type
+                     :name name :count count)
+      (make-instance 'simple-struct-slot :offset offset :type type
+                     :name name)))
+
+;;; Regarding structure alignment, the following ABIs were checked:
+;;;   - System-V ABI: x86, x86-64, ppc, arm, mips and itanium. (more?)
+;;;   - Mac OS X ABI Function Call Guide: ppc32, ppc64 and x86.
+;;;
+;;; Rules used here:
+;;;
+;;;   1. "An entire structure or union object is aligned on the same boundary
+;;;       as its most strictly aligned member."
+;;;   2. "Each member is assigned to the lowest available offset with the
+;;;       appropriate alignment. This may require internal padding, depending
+;;;       on the previous member."
+;;;   3. "A structure's size is increased, if necessary, to make it a multiple
+;;;       of the alignment. This may require tail padding, depending on the last
+;;;       member."
+;;;
+;;; Special case from darwin/ppc32's ABI:
+;;; http://developer.apple.com/documentation/DeveloperTools/Conceptual/LowLevelABI/index.html
+;;;
+;;;   1. "The embedding alignment of the first element in a data structure is
+;;;       equal to the element's natural alignment."
+;;;   2. "For subsequent elements that have a natural alignment greater than 4
+;;;       bytes, the embedding alignment is 4, unless the element is a vector."
+;;;       (note: this applies for structures too)
+
+;; FIXME: get a better name for this. --luis
+(defun get-alignment (type alignment-type firstp)
+  "Return alignment for TYPE according to ALIGNMENT-TYPE."
+  (declare (ignorable firstp))
+  (ecase alignment-type
+    (:normal #-(and cffi-features:darwin cffi-features:ppc32)
+             (foreign-type-alignment type)
+             #+(and cffi-features:darwin cffi-features:ppc32)
+             (if firstp
+                 (foreign-type-alignment type)
+                 (min 4 (foreign-type-alignment type))))))
+
+(defun adjust-for-alignment (type offset alignment-type firstp)
+  "Return OFFSET aligned properly for TYPE according to ALIGNMENT-TYPE."
+  (let* ((align (get-alignment type alignment-type firstp))
+         (rem (mod offset align)))
+    (if (zerop rem)
+        offset
+        (+ offset (- align rem)))))
+
+(defun notice-foreign-struct-definition (name-and-options slots)
+  "Parse and install a foreign structure definition."
+  (destructuring-bind (name &key size #+nil alignment)
+      (mklist name-and-options)
+    (let ((struct (make-instance 'foreign-struct-type :name name))
+          (current-offset 0)
+          (max-align 1)
+          (firstp t))
+      ;; determine offsets
+      (dolist (slotdef slots)
+        (destructuring-bind (slotname type &key (count 1) offset) slotdef
+          (when (eq (canonicalize-foreign-type type) :void)
+            (error "void type not allowed in structure definition: ~S" slotdef))
+          (setq current-offset
+                (or offset
+                    (adjust-for-alignment type current-offset :normal firstp)))
+          (let* ((slot (make-struct-slot slotname current-offset type count))
+                 (align (get-alignment (slot-type slot) :normal firstp)))
+            (setf (gethash slotname (slots struct)) slot)
+            (when (> align max-align)
+              (setq max-align align)))
+          (incf current-offset (* count (foreign-type-size type))))
+        (setq firstp nil))
+      ;; calculate padding and alignment
+      (setf (alignment struct) max-align) ; See point 1 above.
+      (let ((tail-padding (- max-align (rem current-offset max-align))))
+        (unless (= tail-padding max-align) ; See point 3 above.
+          (incf current-offset tail-padding)))
+      (setf (size struct) (or size current-offset))
+      (notice-foreign-type struct))))
+
+(defmacro defcstruct (name &body fields)
+  "Define the layout of a foreign structure."
+  (discard-docstring fields)
+  `(eval-when (:compile-toplevel :load-toplevel :execute)
+     (notice-foreign-struct-definition ',name ',fields)))
+
+;;;## Accessing Foreign Structure Slots
+
+(defun get-slot-info (type slot-name)
+  "Return the slot info for SLOT-NAME or raise an error."
+  (let* ((struct (follow-typedefs (parse-type type)))
+         (info (gethash slot-name (slots struct))))
+    (unless info
+      (error "Undefined slot ~A in foreign type ~A." slot-name type))
+    info))
+
+(defun foreign-slot-pointer (ptr type slot-name)
+  "Return the address of SLOT-NAME in the structure at PTR."
+  (foreign-struct-slot-pointer ptr (get-slot-info type slot-name)))
+
+(defun foreign-slot-offset (type slot-name)
+  "Return the offset of SLOT in a struct TYPE."
+  (slot-offset (get-slot-info type slot-name)))
+
+(defun foreign-slot-value (ptr type slot-name)
+  "Return the value of SLOT-NAME in the foreign structure at PTR."
+  (foreign-struct-slot-value ptr (get-slot-info type slot-name)))
+
+(define-compiler-macro foreign-slot-value (&whole form ptr type slot-name)
+  "Optimizer for FOREIGN-SLOT-VALUE when TYPE is constant."
+  (if (and (constantp type) (constantp slot-name))
+      (foreign-struct-slot-value-form
+       ptr (get-slot-info (eval type) (eval slot-name)))
+      form))
+
+(define-setf-expander foreign-slot-value (ptr type slot-name &environment env)
+  "SETF expander for FOREIGN-SLOT-VALUE."
+  (multiple-value-bind (dummies vals newval setter getter)
+      (get-setf-expansion ptr env)
+    (declare (ignore setter newval))
+    (if (and (constantp type) (constantp slot-name))
+        ;; if TYPE and SLOT-NAME are constant we avoid rebinding them
+        ;; so that the compiler macro on FOREIGN-SLOT-SET works.
+        (with-unique-names (store)
+          (values
+           dummies
+           vals
+           (list store)
+           `(progn
+              (foreign-slot-set ,store ,getter ,type ,slot-name)
+              ,store)
+           `(foreign-slot-value ,getter ,type ,slot-name)))
+        ;; if not...
+        (with-unique-names (store slot-name-tmp type-tmp)
+          (values
+           (list* type-tmp slot-name-tmp dummies)
+           (list* type slot-name vals)
+           (list store)
+           `(progn
+              (foreign-slot-set ,store ,getter ,type-tmp ,slot-name-tmp)
+              ,store)
+           `(foreign-slot-value ,getter ,type-tmp ,slot-name-tmp))))))
+
+(defun foreign-slot-set (value ptr type slot-name)
+  "Set the value of SLOT-NAME in a foreign structure."
+  (setf (foreign-struct-slot-value ptr (get-slot-info type slot-name)) value))
+
+(define-compiler-macro foreign-slot-set
+    (&whole form value ptr type slot-name)
+  "Optimizer when TYPE and SLOT-NAME are constant."
+  (if (and (constantp type) (constantp slot-name))
+      (foreign-struct-slot-set-form
+       value ptr (get-slot-info (eval type) (eval slot-name)))
+      form))
+
+(defmacro with-foreign-slots ((vars ptr type) &body body)
+  "Create local symbol macros for each var in VARS to reference
+foreign slots in PTR of TYPE.  Similar to WITH-SLOTS."
+  (let ((ptr-var (gensym "PTR")))
+    `(let ((,ptr-var ,ptr))
+       (symbol-macrolet
+           ,(loop for var in vars
+                  collect `(,var (foreign-slot-value ,ptr-var ',type ',var)))
+         , at body))))
+
+;;;# Foreign Unions
+;;;
+;;; A union is a FOREIGN-STRUCT-TYPE in which all slots have an offset
+;;; of zero.
+
+;;; See also the notes regarding ABI requirements in
+;;; NOTICE-FOREIGN-STRUCT-DEFINITION
+(defun notice-foreign-union-definition (name-and-options slots)
+  "Parse and install a foreign union definition."
+  (destructuring-bind (name &key size)
+      (mklist name-and-options)
+    (let ((struct (make-instance 'foreign-struct-type :name name))
+          (max-size 0)
+          (max-align 0))
+      (dolist (slotdef slots)
+        (destructuring-bind (slotname type &key (count 1)) slotdef
+          (when (eq (canonicalize-foreign-type type) :void)
+            (error "void type not allowed in union definition: ~S" slotdef))
+          (let* ((slot (make-struct-slot slotname 0 type count))
+                 (size (* count (foreign-type-size type)))
+                 (align (foreign-type-alignment (slot-type slot))))
+            (setf (gethash slotname (slots struct)) slot)
+            (when (> size max-size)
+              (setf max-size size))
+            (when (> align max-align)
+              (setf max-align align)))))
+      (setf (size struct) (or size max-size))
+      (setf (alignment struct) max-align)
+      (notice-foreign-type struct))))
+
+(defmacro defcunion (name &body fields)
+  "Define the layout of a foreign union."
+  (discard-docstring fields)
+  `(eval-when (:compile-toplevel :load-toplevel :execute)
+     (notice-foreign-union-definition ',name ',fields)))
+
+;;;# Operations on Types
+
+(defmethod foreign-type-alignment (type)
+  "Return the alignment in bytes of a foreign type."
+  (foreign-type-alignment (parse-type type)))
+
+(defun foreign-alloc (type &key (initial-element nil initial-element-p)
+                      (initial-contents nil initial-contents-p)
+                      (count 1 count-p) null-terminated-p)
+  "Allocate enough memory to hold COUNT objects of type TYPE. If
+INITIAL-ELEMENT is supplied, each element of the newly allocated
+memory is initialized with its value. If INITIAL-CONTENTS is supplied,
+each of its elements will be used to initialize the contents of the
+newly allocated memory."
+  (let (contents-length)
+    ;; Some error checking, etc...
+    (when (and null-terminated-p
+               (not (eq (canonicalize-foreign-type type) :pointer)))
+      (error "Cannot use :NULL-TERMINATED-P with non-pointer types."))
+    (when (and initial-element-p initial-contents-p)
+      (error "Cannot specify both :INITIAL-ELEMENT and :INITIAL-CONTENTS"))
+    (when initial-contents-p
+      (setq contents-length (length initial-contents))
+      (if count-p
+          (assert (>= count contents-length))
+          (setq count contents-length)))
+    ;; Everything looks good.
+    (let ((ptr (%foreign-alloc (* (foreign-type-size type)
+                                  (if null-terminated-p (1+ count) count)))))
+      (when initial-element-p
+        (dotimes (i count)
+          (setf (mem-aref ptr type i) initial-element)))
+      (when initial-contents-p
+        (dotimes (i contents-length)
+          (setf (mem-aref ptr type i) (elt initial-contents i))))
+      (when null-terminated-p
+        (setf (mem-aref ptr :pointer count) (null-pointer)))
+      ptr)))
+
+;;; Stuff we could optimize here:
+;;;   1. (and (constantp type) (constantp count)) => calculate size
+;;;   2. (constantp type) => use the translators' expanders
+#-(and)
+(define-compiler-macro foreign-alloc
+    (&whole form type &key (initial-element nil initial-element-p)
+     (initial-contents nil initial-contents-p) (count 1 count-p))
+  )
+
+(defmacro with-foreign-object ((var type &optional (count 1)) &body body)
+  "Bind VAR to a pointer to COUNT objects of TYPE during BODY.
+The buffer has dynamic extent and may be stack allocated."
+  `(with-foreign-pointer
+       (,var ,(if (constantp type)
+                  ;; with-foreign-pointer may benefit from constant folding:
+                  (if (constantp count)
+                      (* (eval count) (foreign-type-size (eval type)))
+                      `(* ,count ,(foreign-type-size (eval type))))
+                  `(* ,count (foreign-type-size ,type))))
+     , at body))
+
+(defmacro with-foreign-objects (bindings &rest body)
+  (if bindings
+      `(with-foreign-object ,(car bindings)
+         (with-foreign-objects ,(cdr bindings)
+           , at body))
+      `(progn , at body)))
+
+;;;# User-defined Types and Translations.
+
+(defmacro define-foreign-type (type lambda-list &body body)
+  "Define a parameterized type."
+  (discard-docstring body)
+  `(progn
+     (define-type-spec-parser ,type ,lambda-list
+       (make-instance 'foreign-typedef :name ',type
+                      :actual-type (parse-type (progn , at body))))
+     ',type))
+
+(defmacro defctype (name base-type &key (translate-p t) documentation)
+  "Utility macro for simple C-like typedefs. A similar effect could be
+obtained using define-foreign-type."
+  (declare (ignore documentation))
+  `(eval-when (:compile-toplevel :load-toplevel :execute)
+     (notice-foreign-type
+      (make-instance 'foreign-typedef :name ',name
+                     :actual-type (parse-type ',base-type)
+                     :translate-p ,translate-p))))
+
+;;;## Anonymous Type Translators
+;;;
+;;; (:wrapper :to-c some-function :from-c another-function)
+;;;
+;;; TODO: We will need to add a FREE function to this as well I think.
+;;; --james
+
+(defclass foreign-type-wrapper (foreign-typedef)
+  ((to-c   :initarg :to-c)
+   (from-c :initarg :from-c))
+  (:documentation "Class for the wrapper type."))
+
+(define-type-spec-parser :wrapper (base-type &key to-c from-c)
+  (make-instance 'foreign-type-wrapper 
+                 :actual-type (parse-type base-type)
+                 :to-c (or to-c 'identity)
+                 :from-c (or from-c 'identity)))
+
+(defmethod unparse (name (type foreign-type-wrapper))
+  (declare (ignore name))
+  `(:wrapper ,(name (actual-type type))
+             :to-c ,(slot-value type 'to-c)
+             :from-c ,(slot-value type 'from-c)))
+
+(defmethod translate-type-to-foreign (value (type foreign-type-wrapper))
+  (let ((actual-type (actual-type type)))
+    (translate-type-to-foreign
+     (funcall (slot-value type 'to-c) value) actual-type)))
+
+(defmethod translate-type-from-foreign (value (type foreign-type-wrapper))
+  (let ((actual-type (actual-type type)))
+    (funcall (slot-value type 'from-c)
+             (translate-type-from-foreign value actual-type))))
+
+;;;# Other types
+
+(define-foreign-type :boolean (&optional (base-type :int))
+  "Boolean type. Maps to an :int by default. Only accepts integer types."
+  (ecase (canonicalize-foreign-type base-type)
+    ((:char
+      :unsigned-char
+      :int
+      :unsigned-int
+      :long
+      :unsigned-long) base-type)))
+
+(defmethod unparse ((name (eql :boolean)) type)
+  "Unparser for the :BOOLEAN type."
+  `(:boolean ,(name (actual-type type))))
+
+(defmethod translate-to-foreign (value (name (eql :boolean)))
+  (if value 1 0))
+
+(defmethod translate-from-foreign (value (name (eql :boolean)))
+  (not (zerop value)))
+
+(defmethod expand-to-foreign (value (name (eql :boolean)))
+  "Optimization for the :boolean type."
+  (if (constantp value)
+      (if (eval value) 1 0)
+      `(if ,value 1 0)))
+
+(defmethod expand-from-foreign (value (name (eql :boolean)))
+  "Optimization for the :boolean type."
+  (if (constantp value) ; very unlikely, heh
+      (not (zerop (eval value)))
+      `(not (zerop ,value))))
+
+;;;# Typedefs for built-in types.
+
+(defctype :uchar  :unsigned-char :translate-p nil)
+(defctype :ushort :unsigned-short :translate-p nil)
+(defctype :uint   :unsigned-int :translate-p nil)
+(defctype :ulong  :unsigned-long :translate-p nil)
+
+#-cffi-features:no-long-long
+(progn
+  (defctype :llong  :long-long :translate-p nil)
+  (defctype :ullong :unsigned-long-long :translate-p nil))
+
+;;; We try to define the :[u]int{8,16,32,64} types by looking at
+;;; the sizes of the built-in integer types and defining typedefs.
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (labels ((find-matching-size (size types)
+             (car (member size types :key #'foreign-type-size)))
+           (notice-foreign-typedef (type actual-type)
+             (notice-foreign-type
+              (make-instance 'foreign-typedef :name type
+                             :actual-type (find-type actual-type)
+                             :translate-p nil)))
+           (match-types (sized-types builtin-types)
+             (loop for (type . size) in sized-types do
+                   (let ((match (find-matching-size size builtin-types)))
+                     (when match
+                       (notice-foreign-typedef type match))))))
+    ;; signed
+    (match-types '((:int8 . 1) (:int16 . 2) (:int32 . 4) (:int64 . 8))
+                 '(:char :short :int :long
+                   #-cffi-features:no-long-long :long-long))
+    ;; unsigned
+    (match-types '((:uint8 . 1) (:uint16 . 2) (:uint32 . 4) (:uint64 . 8))
+                 '(:unsigned-char :unsigned-short :unsigned-int :unsigned-long
+                   #-cffi-features:no-long-long :unsigned-long-long))))
\ No newline at end of file

Added: branches/xml-class-rework/thirdparty/cffi/src/utils.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/src/utils.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/src/utils.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,176 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; utils.lisp --- Various utilities.
+;;;
+;;; Copyright (C) 2005, Luis Oliveira  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+(in-package #:cl-user)
+
+(defpackage #:cffi-utils
+  (:use #:common-lisp)
+  (:export #:discard-docstring
+           #:parse-body
+           #:with-unique-names
+           #:once-only
+           #:mklist
+           #:make-gensym-list
+           #:symbolicate
+           #:let-when
+           #:bif
+           #:post-incf))
+
+(in-package #:cffi-utils)
+
+;;;# General Utilities
+
+;;; frodef's, see: http://paste.lisp.org/display/2771#1
+(defmacro post-incf (place &optional (delta 1) &environment env)
+  "Increment PLACE by DELTA and return its previous value."
+  (multiple-value-bind (dummies vals new setter getter)
+      (get-setf-expansion place env)
+    `(let* (,@(mapcar #'list dummies vals) (,(car new) ,getter))
+       (prog1 ,(car new)
+         (setq ,(car new) (+ ,(car new) ,delta))
+         ,setter))))
+
+;;; On Lisp, IIRC.
+(defun mklist (x)
+  "Make into list if atom."
+  (if (listp x) x (list x)))
+
+;;; My own, hah!
+(defmacro discard-docstring (body-var)
+  "Discards the first element of the list in body-var if it's a
+string and the only element."
+  `(when (and (stringp (car ,body-var)) (cdr ,body-var))
+     (pop ,body-var)))
+
+;;; Parse a body of code, removing an optional documentation string
+;;; and declaration forms.  Returns the actual body, docstring, and
+;;; declarations as three multiple values.
+(defun parse-body (body)
+  (let ((docstring nil)
+        (declarations nil))
+    (when (and (stringp (car body)) (cdr body))
+      (setf docstring (pop body)))
+    (loop while (and (consp (car body)) (eql (caar body) 'cl:declare))
+          do (push (pop body) declarations))
+    (values body docstring (nreverse declarations))))
+
+;;; LET-IF (renamed to BIF) and LET-WHEN taken from KMRCL
+(defmacro let-when ((var test-form) &body body)
+  `(let ((,var ,test-form))
+      (when ,var , at body)))
+
+(defmacro bif ((var test-form) if-true &optional if-false)
+  `(let ((,var ,test-form))
+      (if ,var ,if-true ,if-false)))
+
+;;; ONCE-ONLY macro taken from PAIP
+(defun starts-with (list x)
+  "Is x a list whose first element is x?"
+  (and (consp list) (eql (first list) x)))
+
+(defun side-effect-free? (exp)
+  "Is exp a constant, variable, or function,
+  or of the form (THE type x) where x is side-effect-free?"
+  (or (atom exp) (constantp exp)
+      (starts-with exp 'function)
+      (and (starts-with exp 'the)
+           (side-effect-free? (third exp)))))
+
+(defmacro once-only (variables &rest body)
+    "Returns the code built by BODY.  If any of VARIABLES
+  might have side effects, they are evaluated once and stored
+  in temporary variables that are then passed to BODY."
+    (assert (every #'symbolp variables))
+    (let ((temps nil))
+      (dotimes (i (length variables)) (push (gensym "ONCE") temps))
+      `(if (every #'side-effect-free? (list .,variables))
+   (progn .,body)
+   (list 'let
+    ,`(list ,@(mapcar #'(lambda (tmp var)
+                `(list ',tmp ,var))
+            temps variables))
+    (let ,(mapcar #'(lambda (var tmp) `(,var ',tmp))
+             variables temps)
+      .,body)))))
+
+;;;; The following utils were taken from SBCL's
+;;;; src/code/*-extensions.lisp
+
+;;; Automate an idiom often found in macros:
+;;;   (LET ((FOO (GENSYM "FOO"))
+;;;         (MAX-INDEX (GENSYM "MAX-INDEX-")))
+;;;     ...)
+;;;
+;;; "Good notation eliminates thought." -- Eric Siggia
+;;;
+;;; Incidentally, this is essentially the same operator which
+;;; _On Lisp_ calls WITH-GENSYMS.
+(defmacro with-unique-names (symbols &body body)
+  `(let ,(mapcar (lambda (symbol)
+                   (let* ((symbol-name (symbol-name symbol))
+                          (stem (if (every #'alpha-char-p symbol-name)
+                                    symbol-name
+                                    (concatenate 'string symbol-name "-"))))
+                     `(,symbol (gensym ,stem))))
+                 symbols)
+     , at body))
+
+(defun make-gensym-list (n)
+  "Return a list of N gensyms."
+  (loop repeat n collect (gensym)))
+
+(defun symbolicate (&rest things)
+  "Concatenate together the names of some strings and symbols,
+producing a symbol in the current package."
+  (let* ((length (reduce #'+ things
+                         :key (lambda (x) (length (string x)))))
+         (name (make-array length :element-type 'character)))
+    (let ((index 0))
+      (dolist (thing things (values (intern name)))
+        (let* ((x (string thing))
+               (len (length x)))
+          (replace name x :start1 index)
+          (incf index len))))))
+
+;(defun deprecation-warning (bad-name &optional good-name)
+;  (warn "using deprecated ~S~@[, should use ~S instead~]"
+;        bad-name
+;        good-name))
+
+;;; Anaphoric macros
+;(defmacro awhen (test &body body)
+;  `(let ((it ,test))
+;     (when it , at body)))
+
+;(defmacro acond (&rest clauses)
+;  (if (null clauses)
+;      `()
+;      (destructuring-bind ((test &body body) &rest rest) clauses
+;        (once-only (test)
+;          `(if ,test
+;               (let ((it ,test)) (declare (ignorable it)), at body)
+;               (acond , at rest))))))

Added: branches/xml-class-rework/thirdparty/cffi/tests/Makefile
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/tests/Makefile	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/tests/Makefile	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,78 @@
+# -*- Mode: Makefile; tab-width: 3; indent-tabs-mode: t -*-
+#
+# Makefile --- Make targets for various tasks.
+#
+# Copyright (C) 2005, James Bielman  
+#
+# Permission is hereby granted, free of charge, to any person
+# obtaining a copy of this software and associated documentation
+# files (the "Software"), to deal in the Software without
+# restriction, including without limitation the rights to use, copy,
+# modify, merge, publish, distribute, sublicense, and/or sell copies
+# of the Software, and to permit persons to whom the Software is
+# furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be
+# included in all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+# NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+# HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+# DEALINGS IN THE SOFTWARE.
+#
+
+OSTYPE = $(shell uname)
+
+CC             := gcc
+CFLAGS         := -lm -Wall -std=c99 -pedantic
+SHLIB_CFLAGS   := -shared
+SHLIB_EXT      := .so
+
+ifneq ($(if $(findstring $(OSTYPE),Linux FreeBSD),OK), OK)
+ifeq ($(OSTYPE), Darwin)
+SHLIB_CFLAGS   := -bundle
+else
+ifeq ($(OSTYPE), SunOS)
+CFLAGS         := -c -Wall -std=c99 -pedantic
+else
+# Let's assume this is win32
+SHLIB_EXT      := .dll 
+endif
+endif
+endif
+
+ARCH = $(shell uname -m)
+
+ifeq ($(ARCH), x86_64)
+CFLAGS += -fPIC
+endif
+
+# Are all G5s ppc970s?
+ifeq ($(ARCH), ppc970)
+CFLAGS += -m64
+endif
+
+SHLIBS = libtest$(SHLIB_EXT)
+
+ifeq ($(ARCH), x86_64)
+SHLIBS += libtest32$(SHLIB_EXT)
+endif
+
+shlibs: $(SHLIBS)
+
+libtest$(SHLIB_EXT): libtest.c
+	$(CC) -o $@ $(SHLIB_CFLAGS) $(CFLAGS) $<
+
+ifeq ($(ARCH), x86_64)
+libtest32$(SHLIB_EXT): libtest.c
+	$(CC) -m32 -o $@ $(SHLIB_CFLAGS) $(CFLAGS) $<
+endif
+
+clean:
+	rm -f *.so *.dylib *.dll *.bundle
+
+# vim: ft=make ts=3 noet


Property changes on: branches/xml-class-rework/thirdparty/cffi/tests/Makefile
___________________________________________________________________
Name: svn:eol-style
   + native

Added: branches/xml-class-rework/thirdparty/cffi/tests/bindings.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/tests/bindings.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/tests/bindings.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,63 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; libtest.lisp --- Setup CFFI bindings for libtest.
+;;;
+;;; Copyright (C) 2005, Luis Oliveira  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+(in-package #:cffi-tests)
+
+(define-foreign-library libtest
+  (:unix (:or "libtest.so" "libtest32.so"))
+  (:darwin "libtest.so")
+  (:windows "libtest.dll" "msvcrt.dll"))
+
+;;; Return the directory containing the source when compiling or
+;;; loading this file.  We don't use *LOAD-TRUENAME* because the fasl
+;;; file may be in a different directory than the source with certain
+;;; ASDF extensions loaded.
+(defun load-directory ()
+  (let ((here #.(or *compile-file-truename* *load-truename*)))
+    (make-pathname :directory (pathname-directory here))))
+
+(let ((*foreign-library-directories* (list (load-directory))))
+  (load-foreign-library 'libtest))
+
+;;; check libtest version
+(defparameter *required-dll-version* "20060414")
+
+(defcvar "dll_version" :string)
+
+(unless (string= *dll-version* *required-dll-version*)
+  (error (format nil
+                 "version check failed: expected ~s but libtest reports ~s"
+                 *required-dll-version*
+                 *dll-version*)))
+
+;;; The maximum and minimum values for single and double precision C
+;;; floating point values, which may be quite different from the
+;;; corresponding Lisp versions.
+(defcvar "float_max" :float)
+(defcvar "float_min" :float)
+(defcvar "double_max" :double)
+(defcvar "double_min" :double)

Added: branches/xml-class-rework/thirdparty/cffi/tests/callbacks.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/tests/callbacks.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/tests/callbacks.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,491 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; callbacks.lisp --- Tests on callbacks.
+;;;
+;;; Copyright (C) 2005-2006, Luis Oliveira  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+(in-package #:cffi-tests)
+
+(defcfun "expect_char_sum"           :int (f :pointer))
+(defcfun "expect_unsigned_char_sum"  :int (f :pointer))
+(defcfun "expect_short_sum"          :int (f :pointer))
+(defcfun "expect_unsigned_short_sum" :int (f :pointer))
+(defcfun "expect_int_sum"            :int (f :pointer))
+(defcfun "expect_unsigned_int_sum"   :int (f :pointer))
+(defcfun "expect_long_sum"           :int (f :pointer))
+(defcfun "expect_unsigned_long_sum"  :int (f :pointer))
+(defcfun "expect_float_sum"          :int (f :pointer))
+(defcfun "expect_double_sum"         :int (f :pointer))
+(defcfun "expect_pointer_sum"        :int (f :pointer))
+(defcfun "expect_strcat"             :int (f :pointer))
+
+#-cffi-features:no-long-long
+(progn
+  (defcfun "expect_long_long_sum"          :int (f :pointer))
+  (defcfun "expect_unsigned_long_long_sum" :int (f :pointer)))
+
+#+(and scl long-float)
+(defcfun "expect_long_double_sum"    :int (f :pointer))
+
+(defcallback sum-char :char ((a :char) (b :char))
+  "Test if the named block is present and the docstring too."
+  ;(format t "~%}}} a: ~A, b: ~A {{{~%" a b)
+  (return-from sum-char (+ a b)))
+
+(defcallback sum-unsigned-char :unsigned-char
+    ((a :unsigned-char) (b :unsigned-char))
+  ;(format t "~%}}} a: ~A, b: ~A {{{~%" a b)
+  (+ a b))
+
+(defcallback sum-short :short ((a :short) (b :short))
+  ;(format t "~%}}} a: ~A, b: ~A {{{~%" a b)
+  (+ a b))
+
+(defcallback sum-unsigned-short :unsigned-short
+    ((a :unsigned-short) (b :unsigned-short))
+  ;(format t "~%}}} a: ~A, b: ~A {{{~%" a b)
+  (+ a b))
+
+(defcallback sum-int :int ((a :int) (b :int))
+  (+ a b))
+
+(defcallback sum-unsigned-int :unsigned-int
+    ((a :unsigned-int) (b :unsigned-int))
+  (+ a b))
+
+(defcallback sum-long :long ((a :long) (b :long))
+  (+ a b))
+
+(defcallback sum-unsigned-long :unsigned-long
+    ((a :unsigned-long) (b :unsigned-long))
+  (+ a b))
+
+#-cffi-features:no-long-long
+(progn
+  (defcallback sum-long-long :long-long
+      ((a :long-long) (b :long-long))
+    (+ a b))
+  
+  (defcallback sum-unsigned-long-long :unsigned-long-long
+      ((a :unsigned-long-long) (b :unsigned-long-long))
+    (+ a b)))
+
+(defcallback sum-float :float ((a :float) (b :float))
+  ;(format t "~%}}} a: ~A, b: ~A {{{~%" a b)
+  (+ a b))
+
+(defcallback sum-double :double ((a :double) (b :double))
+  ;(format t "~%}}} a: ~A, b: ~A {{{~%" a b)
+  (+ a b))
+
+#+(and scl long-float)
+(defcallback sum-long-double :long-double ((a :long-double) (b :long-double))
+  ;(format t "~%}}} a: ~A, b: ~A {{{~%" a b)
+  (+ a b))
+
+(defcallback sum-pointer :pointer ((ptr :pointer) (offset :int))
+  (inc-pointer ptr offset))
+
+(defcallback lisp-strcat :string ((a :string) (b :string))
+  (concatenate 'string a b))
+
+(deftest callbacks.char
+    (expect-char-sum (get-callback 'sum-char))
+  1)
+
+(deftest callbacks.unsigned-char
+    (expect-unsigned-char-sum (get-callback 'sum-unsigned-char))
+  1)
+
+(deftest callbacks.short
+    (expect-short-sum (callback sum-short))
+  1)
+
+(deftest callbacks.unsigned-short
+    (expect-unsigned-short-sum (callback sum-unsigned-short))
+  1)
+
+(deftest callbacks.int
+    (expect-int-sum (callback sum-int))
+  1)
+
+(deftest callbacks.unsigned-int
+    (expect-unsigned-int-sum (callback sum-unsigned-int))
+  1)
+
+(deftest callbacks.long
+    (expect-long-sum (callback sum-long))
+  1)
+
+(deftest callbacks.unsigned-long
+    (expect-unsigned-long-sum (callback sum-unsigned-long))
+  1)
+
+#-cffi-features:no-long-long
+(progn
+  #+openmcl (push 'callbacks.long-long rt::*expected-failures*)
+
+  (deftest callbacks.long-long
+      (expect-long-long-sum (callback sum-long-long))
+    1)
+  
+  (deftest callbacks.unsigned-long-long
+      (expect-unsigned-long-long-sum (callback sum-unsigned-long-long))
+    1))
+
+(deftest callbacks.float
+    (expect-float-sum (callback sum-float))
+  1)
+
+(deftest callbacks.double
+    (expect-double-sum (callback sum-double))
+  1)
+
+#+(and scl long-float)
+(deftest callbacks.long-double
+    (expect-long-double-sum (callback sum-long-double))
+  1)
+
+(deftest callbacks.pointer
+    (expect-pointer-sum (callback sum-pointer))
+  1)
+
+(deftest callbacks.string
+    (expect-strcat (callback lisp-strcat))
+  1)
+
+#-cffi-features:no-foreign-funcall
+(defcallback return-a-string-not-nil :string ()
+  "abc")
+
+#-cffi-features:no-foreign-funcall
+(deftest callbacks.string-not-docstring
+    (foreign-funcall (callback return-a-string-not-nil) :string)
+  "abc")
+
+;;; This one tests mem-aref too.
+(defcfun "qsort" :void
+  (base :pointer)
+  (nmemb :int)
+  (size :int)
+  (fun-compar :pointer))
+
+(defcallback < :int ((a :pointer) (b :pointer))
+  (let ((x (mem-ref a :int))
+        (y (mem-ref b :int)))
+    (cond ((> x y) 1)
+          ((< x y) -1)
+          (t 0))))
+
+(deftest callbacks.qsort
+    (with-foreign-object (array :int 10)
+      ;; Initialize array.
+      (loop for i from 0 and n in '(7 2 10 4 3 5 1 6 9 8)
+            do (setf (mem-aref array :int i) n))
+      ;; Sort it.
+      (qsort array 10 (foreign-type-size :int) (callback <))
+      ;; Return it as a list.
+      (loop for i from 0 below 10
+            collect (mem-aref array :int i)))
+  (1 2 3 4 5 6 7 8 9 10))
+
+;;; void callback
+(defparameter *int* -1)
+
+(defcfun "pass_int_ref" :void (f :pointer))
+
+;;; CMUCL chokes on this one for some reason.
+#-(and cffi-features:darwin cmu)
+(defcallback read-int-from-pointer :void ((a :pointer))
+  (setq *int* (mem-ref a :int)))
+
+#+(and cffi-features:darwin cmu)
+(pushnew 'callbacks.void rt::*expected-failures*)
+
+(deftest callbacks.void
+    (progn
+      (pass-int-ref (callback read-int-from-pointer))
+      *int*)
+  1984)
+
+;;; test funcalling of a callback and also declarations inside
+;;; callbacks.
+
+#-cffi-features:no-foreign-funcall
+(progn
+  (defcallback sum-2 :int ((a :int) (b :int) (c :int))
+    (declare (ignore c))
+    (+ a b))
+
+  (deftest callbacks.funcall.1
+      (foreign-funcall (callback sum-2) :int 2 :int 3 :int 1 :int)
+    5)
+
+  (defctype foo-float :float)
+
+  (defcallback sum-2f foo-float
+      ((a foo-float) (b foo-float) (c foo-float) (d foo-float) (e foo-float))
+    "This one ignores the middle 3 arguments."
+    (declare (ignore b c))
+    (declare (ignore d))
+    (+ a e))
+
+  (deftest callbacks.funcall.2
+      (foreign-funcall (callback sum-2f) foo-float 1.0 foo-float 2.0
+                       foo-float 3.0 foo-float 4.0 foo-float 5.0 foo-float)
+    6.0))
+
+;;; (cb-test :no-long-long t)
+
+(defcfun "call_sum_127_no_ll" :long (cb :pointer))
+
+;;; CMUCL chokes on this one.
+#-cmu
+(defcallback sum-127-no-ll :long
+    ((a1 :unsigned-long) (a2 :pointer) (a3 :long) (a4 :double)
+     (a5 :unsigned-long) (a6 :float) (a7 :float) (a8 :int) (a9 :unsigned-int)
+     (a10 :double) (a11 :double) (a12 :double) (a13 :pointer)
+     (a14 :unsigned-short) (a15 :unsigned-short) (a16 :pointer) (a17 :long)
+     (a18 :long) (a19 :int) (a20 :short) (a21 :unsigned-short)
+     (a22 :unsigned-short) (a23 :char) (a24 :long) (a25 :pointer) (a26 :pointer)
+     (a27 :char) (a28 :unsigned-char) (a29 :unsigned-long) (a30 :short)
+     (a31 :int) (a32 :int) (a33 :unsigned-char) (a34 :short) (a35 :long)
+     (a36 :long) (a37 :pointer) (a38 :unsigned-short) (a39 :char) (a40 :double)
+     (a41 :unsigned-short) (a42 :pointer) (a43 :short) (a44 :unsigned-long)
+     (a45 :unsigned-short) (a46 :float) (a47 :unsigned-char) (a48 :short)
+     (a49 :float) (a50 :short) (a51 :char) (a52 :unsigned-long)
+     (a53 :unsigned-long) (a54 :char) (a55 :float) (a56 :long) (a57 :pointer)
+     (a58 :short) (a59 :float) (a60 :unsigned-int) (a61 :float)
+     (a62 :unsigned-int) (a63 :double) (a64 :unsigned-int) (a65 :unsigned-char)
+     (a66 :int) (a67 :long) (a68 :char) (a69 :short) (a70 :double) (a71 :int)
+     (a72 :pointer) (a73 :char) (a74 :unsigned-short) (a75 :pointer)
+     (a76 :unsigned-short) (a77 :pointer) (a78 :unsigned-long) (a79 :double)
+     (a80 :pointer) (a81 :long) (a82 :float) (a83 :unsigned-short)
+     (a84 :unsigned-short) (a85 :pointer) (a86 :float) (a87 :int)
+     (a88 :unsigned-int) (a89 :double) (a90 :float) (a91 :long) (a92 :pointer)
+     (a93 :unsigned-short) (a94 :float) (a95 :unsigned-char) (a96 :unsigned-char)
+     (a97 :float) (a98 :unsigned-int) (a99 :float) (a100 :unsigned-short)
+     (a101 :double) (a102 :unsigned-short) (a103 :unsigned-long)
+     (a104 :unsigned-int) (a105 :unsigned-long) (a106 :pointer)
+     (a107 :unsigned-char) (a108 :char) (a109 :char) (a110 :unsigned-short)
+     (a111 :unsigned-long) (a112 :float) (a113 :short) (a114 :pointer)
+     (a115 :long) (a116 :unsigned-short) (a117 :short) (a118 :double)
+     (a119 :short) (a120 :int) (a121 :char) (a122 :unsigned-long) (a123 :long)
+     (a124 :int) (a125 :pointer) (a126 :double) (a127 :unsigned-char))
+  (let ((args (list a1 (pointer-address a2) a3 (floor a4) a5 (floor a6)
+                    (floor a7) a8 a9 (floor a10) (floor a11) (floor a12)
+                    (pointer-address a13) a14 a15 (pointer-address a16) a17 a18
+                    a19 a20 a21 a22 a23 a24 (pointer-address a25)
+                    (pointer-address a26) a27 a28 a29 a30 a31 a32 a33 a34 a35
+                    a36 (pointer-address a37) a38 a39 (floor a40) a41
+                    (pointer-address a42) a43 a44 a45 (floor a46) a47 a48
+                    (floor a49) a50 a51 a52 a53 a54 (floor a55) a56
+                    (pointer-address a57) a58 (floor a59) a60 (floor a61) a62
+                    (floor a63) a64 a65 a66 a67 a68 a69 (floor a70) a71
+                    (pointer-address a72) a73 a74 (pointer-address a75) a76
+                    (pointer-address a77) a78 (floor a79) (pointer-address a80)
+                    a81 (floor a82) a83 a84 (pointer-address a85) (floor a86)
+                    a87 a88 (floor a89) (floor a90) a91 (pointer-address a92)
+                    a93 (floor a94) a95 a96 (floor a97) a98 (floor a99) a100
+                    (floor a101) a102 a103 a104 a105 (pointer-address a106) a107
+                    a108 a109 a110 a111 (floor a112) a113 (pointer-address a114)
+                    a115 a116 a117 (floor a118) a119 a120 a121 a122 a123 a124
+                    (pointer-address a125) (floor a126) a127)))
+    #-(and)
+    (loop for i from 1 and arg in args do
+          (format t "a~A: ~A~%" i arg))
+    (reduce #'+ args)))
+
+#+(or openmcl cmu (and cffi-features:darwin (or allegro lispworks)))
+(push 'callbacks.bff.1 regression-test::*expected-failures*)
+
+(deftest callbacks.bff.1
+    (call-sum-127-no-ll (callback sum-127-no-ll))
+  2008547941)
+
+;;; (cb-test)
+
+#-cffi-features:no-long-long
+(progn
+  (defcfun "call_sum_127" :long-long (cb :pointer))
+
+  ;;; CMUCL chokes on this one.
+  #-cmu
+  (defcallback sum-127 :long-long
+      ((a1 :short) (a2 :char) (a3 :pointer) (a4 :float) (a5 :long) (a6 :double)
+       (a7 :unsigned-long-long) (a8 :unsigned-short) (a9 :unsigned-char)
+       (a10 :char) (a11 :char) (a12 :unsigned-short) (a13 :unsigned-long-long)
+       (a14 :unsigned-short) (a15 :long-long) (a16 :unsigned-short)
+       (a17 :unsigned-long-long) (a18 :unsigned-char) (a19 :unsigned-char)
+       (a20 :unsigned-long-long) (a21 :long-long) (a22 :char) (a23 :float)
+       (a24 :unsigned-int) (a25 :float) (a26 :float) (a27 :unsigned-int)
+       (a28 :float) (a29 :char) (a30 :unsigned-char) (a31 :long) (a32 :long-long)
+       (a33 :unsigned-char) (a34 :double) (a35 :long) (a36 :double)
+       (a37 :unsigned-int) (a38 :unsigned-short) (a39 :long-long)
+       (a40 :unsigned-int) (a41 :int) (a42 :unsigned-long-long) (a43 :long)
+       (a44 :short) (a45 :unsigned-int) (a46 :unsigned-int)
+       (a47 :unsigned-long-long) (a48 :unsigned-int) (a49 :long) (a50 :pointer)
+       (a51 :unsigned-char) (a52 :char) (a53 :long-long) (a54 :unsigned-short)
+       (a55 :unsigned-int) (a56 :float) (a57 :unsigned-char) (a58 :unsigned-long)
+       (a59 :long-long) (a60 :float) (a61 :long) (a62 :float) (a63 :int)
+       (a64 :float) (a65 :unsigned-short) (a66 :unsigned-long-long) (a67 :short)
+       (a68 :unsigned-long) (a69 :long) (a70 :char) (a71 :unsigned-short)
+       (a72 :long-long) (a73 :short) (a74 :double) (a75 :pointer)
+       (a76 :unsigned-int) (a77 :char) (a78 :unsigned-int) (a79 :pointer)
+       (a80 :pointer) (a81 :unsigned-char) (a82 :pointer) (a83 :unsigned-short)
+       (a84 :unsigned-char) (a85 :long) (a86 :pointer) (a87 :char) (a88 :long)
+       (a89 :unsigned-short) (a90 :unsigned-char) (a91 :double)
+       (a92 :unsigned-long-long) (a93 :unsigned-short) (a94 :unsigned-short)
+       (a95 :unsigned-int) (a96 :long) (a97 :char) (a98 :long) (a99 :char)
+       (a100 :short) (a101 :unsigned-short) (a102 :unsigned-long)
+       (a103 :unsigned-long) (a104 :short) (a105 :long-long) (a106 :long-long)
+       (a107 :long-long) (a108 :double) (a109 :unsigned-short)
+       (a110 :unsigned-char) (a111 :short) (a112 :unsigned-char) (a113 :long)
+       (a114 :long-long) (a115 :unsigned-long-long) (a116 :unsigned-int)
+       (a117 :unsigned-long) (a118 :unsigned-char) (a119 :long-long)
+       (a120 :unsigned-char) (a121 :unsigned-long-long) (a122 :double)
+       (a123 :unsigned-char) (a124 :long-long) (a125 :unsigned-char)
+       (a126 :char) (a127 :long-long))
+    (+ a1 a2 (pointer-address a3) (values (floor a4)) a5 (values (floor a6))
+       a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22
+       (values (floor a23)) a24 (values (floor a25)) (values (floor a26))
+       a27 (values (floor a28)) a29 a30 a31 a32 a33 (values (floor a34))
+       a35 (values (floor a36)) a37 a38 a39 a40 a41 a42 a43 a44 a45 a46 a47
+       a48 a49 (pointer-address a50) a51 a52 a53 a54 a55 (values (floor a56))
+       a57 a58 a59 (values (floor a60)) a61 (values (floor a62)) a63
+       (values (floor a64)) a65 a66 a67 a68 a69 a70 a71 a72 a73
+       (values (floor a74)) (pointer-address a75) a76 a77 a78
+       (pointer-address a79) (pointer-address a80) a81 (pointer-address a82)
+       a83 a84 a85 (pointer-address a86) a87 a88 a89 a90 (values (floor a91))
+       a92 a93 a94 a95 a96 a97 a98 a99 a100 a101 a102 a103 a104 a105 a106 a107
+       (values (floor a108)) a109 a110 a111 a112 a113 a114 a115 a116 a117 a118
+       a119 a120 a121 (values (floor a122)) a123 a124 a125 a126 a127))
+
+  #+(or openmcl cmu)
+  (push 'callbacks.bff.2 rt::*expected-failures*)
+  
+  (deftest callbacks.bff.2
+      (call-sum-127 (callback sum-127))
+    8166570665645582011))
+
+;;; regression test: (callback non-existant-callback) should throw an error
+(deftest callbacks.non-existant
+    (not (null (nth-value 1 (ignore-errors (callback doesnt-exist)))))
+  t)
+
+;;; Handling many arguments of type double. Many lisps (used to) fail
+;;; this one on darwin/ppc. This test might be bogus due to floating
+;;; point arithmetic rounding errors.
+;;;
+;;; CMUCL chokes on this one.
+#-(and cffi-features:darwin cmu)
+(defcallback double26 :double
+    ((a1 :double) (a2 :double) (a3 :double) (a4 :double) (a5 :double)
+     (a6 :double) (a7 :double) (a8 :double) (a9 :double) (a10 :double)
+     (a11 :double) (a12 :double) (a13 :double) (a14 :double) (a15 :double)
+     (a16 :double) (a17 :double) (a18 :double) (a19 :double) (a20 :double)
+     (a21 :double) (a22 :double) (a23 :double) (a24 :double) (a25 :double)
+     (a26 :double))
+  (let ((args (list a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15
+                    a16 a17 a18 a19 a20 a21 a22 a23 a24 a25 a26)))
+    #-(and)
+    (loop for i from 1 and arg in args do
+          (format t "a~A: ~A~%" i arg))
+    (reduce #'+ args)))
+
+(defcfun "call_double26" :double (f :pointer))
+
+#+(and cffi-features:darwin (or allegro cmu))
+(pushnew 'callbacks.double26 rt::*expected-failures*)
+
+(deftest callbacks.double26
+    (call-double26 (callback double26))
+  81.64d0)
+
+#+(and cffi-features:darwin cmu)
+(pushnew 'callbacks.double26.funcall rt::*expected-failures*)
+
+#-cffi-features:no-foreign-funcall
+(deftest callbacks.double26.funcall
+    (foreign-funcall (callback double26) :double 3.14d0 :double 3.14d0
+                     :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
+                     :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
+                     :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
+                     :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
+                     :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
+                     :double 3.14d0 :double 3.14d0 :double 3.14d0 :double 3.14d0
+                     :double)
+  81.64d0)
+
+;;; Same as above, for floats.
+#-(and cffi-features:darwin cmu)
+(defcallback float26 :float
+    ((a1 :float) (a2 :float) (a3 :float) (a4 :float) (a5 :float)
+     (a6 :float) (a7 :float) (a8 :float) (a9 :float) (a10 :float)
+     (a11 :float) (a12 :float) (a13 :float) (a14 :float) (a15 :float)
+     (a16 :float) (a17 :float) (a18 :float) (a19 :float) (a20 :float)
+     (a21 :float) (a22 :float) (a23 :float) (a24 :float) (a25 :float)
+     (a26 :float))
+  (let ((args (list a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15
+                    a16 a17 a18 a19 a20 a21 a22 a23 a24 a25 a26)))
+    #-(and)
+    (loop for i from 1 and arg in args do
+          (format t "a~A: ~A~%" i arg))
+    (reduce #'+ args)))
+
+(defcfun "call_float26" :float (f :pointer))
+
+#+(and cffi-features:darwin (or lispworks openmcl cmu))
+(pushnew 'callbacks.float26 regression-test::*expected-failures*)
+
+(deftest callbacks.float26
+    (call-float26 (callback float26))
+  130.0)
+
+#+(and cffi-features:darwin (or lispworks openmcl cmu))
+(pushnew 'callbacks.float26.funcall regression-test::*expected-failures*)
+
+#-cffi-features:no-foreign-funcall
+(deftest callbacks.float26.funcall
+    (foreign-funcall (callback float26) :float 5.0 :float 5.0
+                     :float 5.0 :float 5.0 :float 5.0 :float 5.0
+                     :float 5.0 :float 5.0 :float 5.0 :float 5.0
+                     :float 5.0 :float 5.0 :float 5.0 :float 5.0
+                     :float 5.0 :float 5.0 :float 5.0 :float 5.0
+                     :float 5.0 :float 5.0 :float 5.0 :float 5.0
+                     :float 5.0 :float 5.0 :float 5.0 :float 5.0
+                     :float)
+  130.0)
+
+;;; Defining a callback as a non-toplevel form. Not portable. Doesn't
+;;; work for CMUCL or Allegro.
+#-(and)
+(let ((n 42))
+  (defcallback non-toplevel-cb :int ()
+    n))
+
+#-(and)
+(deftest callbacks.non-toplevel
+    (foreign-funcall (callback non-toplevel-cb) :int)
+  42)
\ No newline at end of file

Added: branches/xml-class-rework/thirdparty/cffi/tests/compile.bat
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/tests/compile.bat	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/tests/compile.bat	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,6 @@
+rem
+rem script for compiling the test lib with the free MSVC++ toolkit.
+rem
+
+cl /ML /LD -D_MT /DWIN32=1 libtest.c
+del libtest.obj libtest.exp

Added: branches/xml-class-rework/thirdparty/cffi/tests/defcfun.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/tests/defcfun.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/tests/defcfun.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,357 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; defcfun.lisp --- Tests function definition and calling.
+;;;
+;;; Copyright (C) 2005-2006, Luis Oliveira  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+(in-package #:cffi-tests)
+
+;;;# Calling with built-in c types
+;;;
+;;; Tests calling standard C library functions both passing
+;;; and returning each built-in type. (adapted from funcall.lisp)
+
+(defcfun "toupper" :char
+  (char :char))
+
+(deftest defcfun.char
+    (toupper (char-code #\a))
+  #.(char-code #\A))
+
+
+(defcfun ("abs" c-abs) :int
+  (n :int))
+
+(deftest defcfun.int
+    (c-abs -100)
+  100)
+
+
+(defcfun "labs" :long
+  (n :long))
+
+(deftest defcfun.long
+    (labs -131072)
+  131072)
+
+
+#-cffi-features:no-long-long
+(progn
+  (defcfun "my_llabs" :long-long
+    (n :long-long))
+
+  (deftest defcfun.long-long
+      (my-llabs -9223372036854775807)
+    9223372036854775807))
+
+
+(defcfun "my_sqrtf" :float
+  (n :float))
+
+(deftest defcfun.float
+    (my-sqrtf 16.0)
+  4.0)
+
+
+(defcfun ("sqrt" c-sqrt) :double
+  (n :double))
+
+(deftest defcfun.double
+    (c-sqrt 36.0d0)
+  6.0d0)
+
+
+#+(and scl long-float)
+(defcfun ("sqrtl" c-sqrtl) :long-double
+  (n :long-double))
+
+#+(and scl long-float)
+(deftest defcfun.long-double
+    (c-sqrtl 36.0l0)
+  6.0l0)
+
+
+(defcfun "strlen" :int
+  (n :string))
+
+(deftest defcfun.string.1
+    (strlen "Hello")
+  5)
+
+
+(defcfun "strcpy" :pointer
+  (dest :pointer)
+  (src :string))
+
+(defcfun "strcat" :pointer
+  (dest :pointer)
+  (src :string))
+
+(deftest defcfun.string.2
+    (with-foreign-pointer-as-string (s 100)
+      (setf (mem-ref s :char) 0)
+      (strcpy s "Hello")
+      (strcat s ", world!"))
+  "Hello, world!")
+
+(defcfun "strerror" :string
+  (n :int))
+
+(deftest defcfun.string.3
+    (typep (strerror 1) 'string)
+  t)
+
+
+;;; Regression test. Allegro would warn on direct calls to
+;;; functions with no arguments.
+;;; Also, let's check if void functions will return NIL.
+
+(defcfun "noargs" :int)
+
+(deftest defcfun.noargs
+    (noargs)
+  42)
+
+(defcfun "noop" :void)
+
+(deftest defcfun.noop
+    (noop)
+  nil)
+
+;;;# Calling varargs functions
+
+(defcfun "sprintf" :int
+  (str :pointer)
+  (control :string)
+  &rest)
+
+(deftest defcfun.varargs.char
+    (with-foreign-pointer-as-string (s 100)
+      (sprintf s "%c" :char 65))
+  "A")
+
+(deftest defcfun.varargs.short
+    (with-foreign-pointer-as-string (s 100)
+      (sprintf s "%d" :short 42))
+  "42")
+
+(deftest defcfun.varargs.int
+    (with-foreign-pointer-as-string (s 100)
+      (sprintf s "%d" :int 1000))
+  "1000")
+
+(deftest defcfun.varargs.long
+    (with-foreign-pointer-as-string (s 100)
+      (sprintf s "%ld" :long 131072))
+  "131072")
+
+(deftest defcfun.varargs.float
+    (with-foreign-pointer-as-string (s 100)
+      (sprintf s "%.2f" :float (float pi)))
+  "3.14")
+    
+(deftest defcfun.varargs.double
+    (with-foreign-pointer-as-string (s 100)
+      (sprintf s "%.2f" :double (float pi 1.0d0)))
+  "3.14")
+
+#+(and scl long-float)
+(deftest defcfun.varargs.long-double
+    (with-foreign-pointer-as-string (s 100)
+      (setf (mem-ref s :char) 0)
+      (sprintf s "%.2Lf" :long-double pi))
+  "3.14")
+
+(deftest defcfun.varargs.string
+    (with-foreign-pointer-as-string (s 100)
+      (sprintf s "%s, %s!" :string "Hello" :string "world"))
+  "Hello, world!")
+
+;;; (let ((rettype (find-type :long))
+;;;       (arg-types (n-random-types-no-ll 127)))
+;;;   (c-function rettype arg-types)
+;;;   (gen-function-test rettype arg-types))
+
+(defcfun "sum_127_no_ll" :long
+  (a1 :long) (a2 :unsigned-long) (a3 :short) (a4 :unsigned-short) (a5 :float)
+  (a6 :double) (a7 :unsigned-long) (a8 :float) (a9 :unsigned-char)
+  (a10 :unsigned-short) (a11 :short) (a12 :unsigned-long) (a13 :double)
+  (a14 :long) (a15 :unsigned-int) (a16 :pointer) (a17 :unsigned-int)
+  (a18 :unsigned-short) (a19 :long) (a20 :float) (a21 :pointer) (a22 :float)
+  (a23 :int) (a24 :int) (a25 :unsigned-short) (a26 :long) (a27 :long)
+  (a28 :double) (a29 :unsigned-char) (a30 :unsigned-int) (a31 :unsigned-int)
+  (a32 :int) (a33 :unsigned-short) (a34 :unsigned-int) (a35 :pointer)
+  (a36 :double) (a37 :double) (a38 :long) (a39 :short) (a40 :unsigned-short)
+  (a41 :long) (a42 :char) (a43 :long) (a44 :unsigned-short) (a45 :pointer)
+  (a46 :int) (a47 :unsigned-int) (a48 :double) (a49 :unsigned-char)
+  (a50 :unsigned-char) (a51 :float) (a52 :int) (a53 :unsigned-short)
+  (a54 :double) (a55 :short) (a56 :unsigned-char) (a57 :unsigned-long)
+  (a58 :float) (a59 :float) (a60 :float) (a61 :pointer) (a62 :pointer)
+  (a63 :unsigned-int) (a64 :unsigned-long) (a65 :char) (a66 :short)
+  (a67 :unsigned-short) (a68 :unsigned-long) (a69 :pointer) (a70 :float)
+  (a71 :double) (a72 :long) (a73 :unsigned-long) (a74 :short)
+  (a75 :unsigned-int) (a76 :unsigned-short) (a77 :int) (a78 :unsigned-short)
+  (a79 :char) (a80 :double) (a81 :short) (a82 :unsigned-char) (a83 :float)
+  (a84 :char) (a85 :int) (a86 :double) (a87 :unsigned-char) (a88 :int)
+  (a89 :unsigned-long) (a90 :double) (a91 :short) (a92 :short)
+  (a93 :unsigned-int) (a94 :unsigned-char) (a95 :float) (a96 :long) (a97 :float)
+  (a98 :long) (a99 :long) (a100 :int) (a101 :int) (a102 :unsigned-int)
+  (a103 :char) (a104 :char) (a105 :unsigned-short) (a106 :unsigned-int)
+  (a107 :unsigned-short) (a108 :unsigned-short) (a109 :int) (a110 :long)
+  (a111 :char) (a112 :double) (a113 :unsigned-int) (a114 :char) (a115 :short)
+  (a116 :unsigned-long) (a117 :unsigned-int) (a118 :short) (a119 :unsigned-char)
+  (a120 :float) (a121 :pointer) (a122 :double) (a123 :int) (a124 :long)
+  (a125 :char) (a126 :unsigned-short) (a127 :float))
+
+(deftest defcfun.bff.1
+    (sum-127-no-ll
+     1442906394 520035521 -4715 50335 -13557.0 -30892.0d0 24061483 -23737.0 22
+     2348 4986 104895680 8073.0d0 -571698147 102484400 (make-pointer 507907275)
+     12733353 7824 -1275845284 13602.0 (make-pointer 286958390) -8042.0
+     -773681663 -1289932452 31199 -154985357 -170994216 16845.0d0 177
+     218969221 2794350893 6068863 26327 127699339 (make-pointer 184352771)
+     18512.0d0 -12345.0d0 -179853040 -19981 37268 -792845398 116 -1084653028
+     50494 (make-pointer 2105239646) -1710519651 1557813312 2839.0d0 90 180
+     30580.0 -532698978 8623 9537.0d0 -10882 54 184357206 14929.0 -8190.0
+     -25615.0 (make-pointer 235310526) (make-pointer 220476977) 7476055 1576685
+     -117 -11781 31479 23282640 (make-pointer 8627281) -17834.0 10391.0d0
+     -1904504370 114393659 -17062 637873619 16078 -891210259 8107 0 760.0d0
+     -21268 104 14133.0 10 588598141 310.0d0 20 1351785456 16159552 -10121.0d0
+     -25866 24821 68232851 60 -24132.0 -1660411658 13387.0 -786516668 -499825680
+     -1128144619 111849719 2746091587 -2 95 14488 326328135 64781 18204
+     150716680 -703859275 103 16809.0d0 852235610 -43 21088 242356110 324325428
+     -22380 23 24814.0 (make-pointer 40362014) -14322.0d0 -1864262539 523684371
+     -21 49995 -29175.0)
+  796447501)
+
+;;; (let ((rettype (find-type :long-long))
+;;;       (arg-types (n-random-types 127)))
+;;;   (c-function rettype arg-types)
+;;;   (gen-function-test rettype arg-types))
+
+#-cffi-features:no-long-long
+(progn
+  (defcfun "sum_127" :long-long
+    (a1 :pointer) (a2 :pointer) (a3 :float) (a4 :unsigned-long) (a5 :pointer)
+    (a6 :long-long) (a7 :double) (a8 :double) (a9 :unsigned-short) (a10 :int)
+    (a11 :long-long) (a12 :long) (a13 :short) (a14 :unsigned-int) (a15 :long)
+    (a16 :unsigned-char) (a17 :int) (a18 :double) (a19 :short) (a20 :short)
+    (a21 :long-long) (a22 :unsigned-int) (a23 :unsigned-short) (a24 :short)
+    (a25 :pointer) (a26 :short) (a27 :unsigned-short) (a28 :unsigned-short)
+    (a29 :int) (a30 :long-long) (a31 :pointer) (a32 :int) (a33 :unsigned-long)
+    (a34 :unsigned-long) (a35 :pointer) (a36 :unsigned-long-long) (a37 :float)
+    (a38 :int) (a39 :short) (a40 :pointer) (a41 :unsigned-long-long)
+    (a42 :long-long) (a43 :unsigned-long) (a44 :unsigned-long)
+    (a45 :unsigned-long-long) (a46 :unsigned-long) (a47 :char) (a48 :double)
+    (a49 :long) (a50 :unsigned-int) (a51 :int) (a52 :short) (a53 :pointer)
+    (a54 :long) (a55 :unsigned-long-long) (a56 :int) (a57 :unsigned-short)
+    (a58 :unsigned-long-long) (a59 :float) (a60 :pointer) (a61 :float)
+    (a62 :unsigned-short) (a63 :unsigned-long) (a64 :float) (a65 :unsigned-int)
+    (a66 :unsigned-long-long) (a67 :pointer) (a68 :double)
+    (a69 :unsigned-long-long) (a70 :double) (a71 :double) (a72 :long-long)
+    (a73 :pointer) (a74 :unsigned-short) (a75 :long) (a76 :pointer) (a77 :short)
+    (a78 :double) (a79 :long) (a80 :unsigned-char) (a81 :pointer)
+    (a82 :unsigned-char) (a83 :long) (a84 :double) (a85 :pointer) (a86 :int)
+    (a87 :double) (a88 :unsigned-char) (a89 :double) (a90 :short) (a91 :long)
+    (a92 :int) (a93 :long) (a94 :double) (a95 :unsigned-short)
+    (a96 :unsigned-int) (a97 :int) (a98 :char) (a99 :long-long) (a100 :double)
+    (a101 :float) (a102 :unsigned-long) (a103 :short) (a104 :pointer)
+    (a105 :float) (a106 :long-long) (a107 :int) (a108 :long-long)
+    (a109 :long-long) (a110 :double) (a111 :unsigned-long-long) (a112 :double)
+    (a113 :unsigned-long) (a114 :char) (a115 :char) (a116 :unsigned-long)
+    (a117 :short) (a118 :unsigned-char) (a119 :unsigned-char) (a120 :int)
+    (a121 :int) (a122 :float) (a123 :unsigned-char) (a124 :unsigned-char)
+    (a125 :double) (a126 :unsigned-long-long) (a127 :char))
+
+  (deftest defcfun.bff.2 
+      (sum-127
+       (make-pointer 2746181372) (make-pointer 177623060) -32334.0 3158055028
+       (make-pointer 242315091) 4288001754991016425 -21047.0d0 287.0d0 18722
+       243379286 -8677366518541007140 581399424 -13872 4240394881 1353358999
+       226 969197676 -26207.0d0 6484 11150 1241680089902988480 106068320 61865
+       2253 (make-pointer 866809333) -31613 35616 11715 1393601698
+       8940888681199591845 (make-pointer 1524606024) 805638893 3315410736
+       3432596795 (make-pointer 1490355706) 696175657106383698 -25438.0
+       1294381547 26724 (make-pointer 3196569545) 2506913373410783697
+       -4405955718732597856 4075932032 3224670123 2183829215657835866
+       1318320964 -22 -3786.0d0 -2017024146 1579225515 -626617701 -1456
+       (make-pointer 3561444187) 395687791 1968033632506257320 -1847773261
+       48853 142937735275669133 -17974.0 (make-pointer 2791749948) -14140.0
+       2707 3691328585 3306.0 1132012981 303633191773289330
+       (make-pointer 981183954) 9114.0d0 8664374572369470 -19013.0d0
+       -10288.0d0 -3679345119891954339 (make-pointer 3538786709) 23761
+       -154264605 (make-pointer 2694396308) 7023 997.0d0 1009561368 241
+       (make-pointer 2612292671) 48 1431872408 -32675.0d0
+       (make-pointer 1587599336) 958916472 -9857.0d0 111 -14370.0d0 -7308
+       -967514912 488790941 2146978095 -24111.0d0 13711 86681861 717987770
+       111 1013402998690933877 17234.0d0 -8772.0 3959216275 -8711
+       (make-pointer 3142780851) 9480.0 -3820453146461186120 1616574376
+       -3336232268263990050 -1906114671562979758 -27925.0d0 9695970875869913114
+       27033.0d0 1096518219 -12 104 3392025403 -27911 60 89 509297051
+       -533066551 29158.0 110 54 -9802.0d0 593950442165910888 -79)
+    7758614658402721936))
+
+;;; regression test: defining an undefined foreign function should only
+;;; throw some sort of warning, not signal an error.
+
+#+(or cmu (and sbcl (or (not linkage-table) win32)))
+(pushnew 'defcfun.undefined rt::*expected-failures*)
+
+(deftest defcfun.undefined
+    (progn
+      (eval '(defcfun ("undefined_foreign_function" undefined-foreign-function) :void))
+      (compile 'undefined-foreign-function)
+      t)
+  t)
+
+;;; Test whether all doubles are passed correctly. On some platforms, eg.
+;;; darwin/ppc, some are passed on registers others on the stack.
+(defcfun "sum_double26" :double
+  (a1 :double) (a2 :double) (a3 :double) (a4 :double) (a5 :double)
+  (a6 :double) (a7 :double) (a8 :double) (a9 :double) (a10 :double)
+  (a11 :double) (a12 :double) (a13 :double) (a14 :double) (a15 :double)
+  (a16 :double) (a17 :double) (a18 :double) (a19 :double) (a20 :double)
+  (a21 :double) (a22 :double) (a23 :double) (a24 :double) (a25 :double)
+  (a26 :double))
+
+(deftest defcfun.double26
+    (sum-double26 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0
+                  3.14d0 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0
+                  3.14d0 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0 3.14d0
+                  3.14d0 3.14d0 3.14d0 3.14d0 3.14d0)
+  81.64d0)
+
+;;; Same as above for floats.
+(defcfun "sum_float26" :float
+  (a1 :float) (a2 :float) (a3 :float) (a4 :float) (a5 :float)
+  (a6 :float) (a7 :float) (a8 :float) (a9 :float) (a10 :float)
+  (a11 :float) (a12 :float) (a13 :float) (a14 :float) (a15 :float)
+  (a16 :float) (a17 :float) (a18 :float) (a19 :float) (a20 :float)
+  (a21 :float) (a22 :float) (a23 :float) (a24 :float) (a25 :float)
+  (a26 :float))
+
+(deftest defcfun.float26
+    (sum-float26 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0
+                 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0)
+  130.0)

Added: branches/xml-class-rework/thirdparty/cffi/tests/enum.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/tests/enum.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/tests/enum.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,65 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; enum.lisp --- Tests on C enums.
+;;;
+;;; Copyright (C) 2005, Luis Oliveira  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+(in-package #:cffi-tests)
+
+(defcenum numeros
+  (:one 1)
+  :two
+  :three
+  :four
+  (:forty-one 41)
+  :forty-two)
+
+(defcfun "check_enums" :int
+  (one numeros)
+  (two numeros)
+  (three numeros)
+  (four numeros)
+  (forty-one numeros)
+  (forty-two numeros))
+
+(deftest enum.1
+    (check-enums :one :two :three 4 :forty-one :forty-two)
+  1)
+
+(defcenum another-boolean :false :true)
+(defcfun "return_enum" another-boolean (x :int))
+
+(deftest enum.2
+    (and (eq :false (return-enum 0))
+         (eq :true (return-enum 1)))
+  t)
+
+(defctype yet-another-boolean another-boolean)
+(defcfun ("return_enum" return-enum2) yet-another-boolean
+  (x yet-another-boolean))
+
+(deftest enum.3
+    (and (eq :false (return-enum2 :false))
+         (eq :true (return-enum2 :true)))
+  t)

Added: branches/xml-class-rework/thirdparty/cffi/tests/foreign-globals.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/tests/foreign-globals.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/tests/foreign-globals.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,230 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; foreign-globals.lisp --- Tests on foreign globals.
+;;;
+;;; Copyright (C) 2005, Luis Oliveira  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+(in-package #:cffi-tests)
+
+(defcvar ("var_char" *char-var*) :char)
+(defcvar "var_unsigned_char"     :unsigned-char)
+(defcvar "var_short"             :short)
+(defcvar "var_unsigned_short"    :unsigned-short)
+(defcvar "var_int"               :int)
+(defcvar "var_unsigned_int"      :unsigned-int)
+(defcvar "var_long"              :long)
+(defcvar "var_unsigned_long"     :unsigned-long)
+(defcvar "var_float"             :float)
+(defcvar "var_double"            :double)
+(defcvar "var_pointer"           :pointer)
+(defcvar "var_string"            :string)
+
+#-cffi-features:no-long-long
+(progn
+  (defcvar "var_long_long"          :long-long)
+  (defcvar "var_unsigned_long_long" :unsigned-long-long))
+
+(deftest foreign-globals.ref.char
+    *char-var*
+  -127)
+
+(deftest foreign-globals.ref.unsigned-char
+    *var-unsigned-char*
+  255)
+
+(deftest foreign-globals.ref.short
+    *var-short*
+  -32767)
+
+(deftest foreign-globals.ref.unsigned-short
+    *var-unsigned-short*
+  65535)
+
+(deftest foreign-globals.ref.int
+    *var-int*
+  -32767)
+
+(deftest foreign-globals.ref.unsigned-int
+    *var-unsigned-int*
+  65535)
+
+(deftest foreign-globals.ref.long
+    *var-long*
+  -2147483647)
+
+(deftest foreign-globals.ref.unsigned-long
+    *var-unsigned-long*
+  4294967295)
+
+(deftest foreign-globals.ref.float
+    *var-float*
+  42.0)
+
+(deftest foreign-globals.ref.double
+    *var-double*
+  42.0d0)
+
+(deftest foreign-globals.ref.pointer
+    (null-pointer-p *var-pointer*)
+  t)
+
+(deftest foreign-globals.ref.string
+    *var-string*
+  "Hello, foreign world!")
+
+#-cffi-features:no-long-long
+(progn
+  #+openmcl (push 'foreign-globals.set.long-long rt::*expected-failures*)
+
+  (deftest foreign-globals.ref.long-long
+      *var-long-long*
+    -9223372036854775807)
+
+  (deftest foreign-globals.ref.unsigned-long-long
+      *var-unsigned-long-long*
+    18446744073709551615))
+
+;; The *.set.* tests restore the old values so that the *.ref.*
+;; don't fail when re-run.
+(defmacro with-old-value-restored ((place) &body body)
+  (let ((old (gensym)))
+    `(let ((,old ,place))
+       (prog1
+           (progn , at body)
+         (setq ,place ,old)))))
+
+(deftest foreign-globals.set.int
+    (with-old-value-restored (*var-int*)
+      (setq *var-int* 42)
+      *var-int*)
+  42)
+
+(deftest foreign-globals.set.string
+    (with-old-value-restored (*var-string*)
+      (setq *var-string* "Ehxosxangxo")
+      (prog1
+          *var-string*
+        ;; free the string we just allocated
+        (foreign-free (mem-ref (get-var-pointer '*var-string*) :pointer))))
+  "Ehxosxangxo")
+
+#-cffi-features:no-long-long
+(deftest foreign-globals.set.long-long
+    (with-old-value-restored (*var-long-long*)
+      (setq *var-long-long* -9223000000000005808)
+      *var-long-long*)
+  -9223000000000005808)
+
+(deftest foreign-globals.get-var-pointer.1
+    (pointerp (get-var-pointer '*char-var*))
+  t)
+
+(deftest foreign-globals.get-var-pointer.2
+    (mem-ref (get-var-pointer '*char-var*) :char)
+  -127)
+
+;;; Symbol case.
+
+(defcvar "UPPERCASEINT1"     :int)
+(defcvar "UPPER_CASE_INT1"   :int)
+(defcvar "MiXeDCaSeInT1"     :int)
+(defcvar "MiXeD_CaSe_InT1"   :int)
+
+(deftest foreign-globals.ref.uppercaseint1
+    *uppercaseint1*
+  12345)
+
+(deftest foreign-globals.ref.upper-case-int1
+    *upper-case-int1*
+  23456)
+
+(deftest foreign-globals.ref.mixedcaseint1
+    *mixedcaseint1*
+  34567)
+
+(deftest foreign-globals.ref.mixed-case-int1
+    *mixed-case-int1*
+  45678)
+
+(when (string= (symbol-name 'nil) "NIL")
+  (let ((*readtable* (copy-readtable)))
+    (setf (readtable-case *readtable*) :invert)
+    (eval (read-from-string "(defcvar \"UPPERCASEINT2\"     :int)"))
+    (eval (read-from-string "(defcvar \"UPPER_CASE_INT2\"   :int)"))
+    (eval (read-from-string "(defcvar \"MiXeDCaSeInT2\"     :int)"))
+    (eval (read-from-string "(defcvar \"MiXeD_CaSe_InT2\"   :int)"))
+    (setf (readtable-case *readtable*) :preserve)
+    (eval (read-from-string "(DEFCVAR \"UPPERCASEINT3\"     :INT)"))
+    (eval (read-from-string "(DEFCVAR \"UPPER_CASE_INT3\"   :INT)"))
+    (eval (read-from-string "(DEFCVAR \"MiXeDCaSeInT3\"     :INT)"))
+    (eval (read-from-string "(DEFCVAR \"MiXeD_CaSe_InT3\"   :INT)"))))
+    
+
+(when (string= (symbol-name 'nil) "nil")
+  (let ((*readtable* (copy-readtable)))
+    (setf (readtable-case *readtable*) :invert)
+    (eval (read-from-string "(DEFCVAR \"UPPERCASEINT2\"     :INT)"))
+    (eval (read-from-string "(DEFCVAR \"UPPER_CASE_INT2\"   :INT)"))
+    (eval (read-from-string "(DEFCVAR \"MiXeDCaSeInT2\"     :INT)"))
+    (eval (read-from-string "(DEFCVAR \"MiXeD_CaSe_InT2\"   :INT)"))
+    (setf (readtable-case *readtable*) :downcase)
+    (eval (read-from-string "(defcvar \"UPPERCASEINT3\"     :int)"))
+    (eval (read-from-string "(defcvar \"UPPER_CASE_INT3\"   :int)"))
+    (eval (read-from-string "(defcvar \"MiXeDCaSeInT3\"     :int)"))
+    (eval (read-from-string "(defcvar \"MiXeD_CaSe_InT3\"   :int)"))))
+
+(deftest foreign-globals.ref.uppercaseint2
+    *uppercaseint2*
+  12345)
+
+(deftest foreign-globals.ref.upper-case-int2
+    *upper-case-int2*
+  23456)
+
+(deftest foreign-globals.ref.mixedcaseint2
+    *mixedcaseint2*
+  34567)
+
+(deftest foreign-globals.ref.mixed-case-int2
+    *mixed-case-int2*
+  45678)
+
+(deftest foreign-globals.ref.uppercaseint3
+    *uppercaseint3*
+  12345)
+
+(deftest foreign-globals.ref.upper-case-int3
+    *upper-case-int3*
+  23456)
+
+(deftest foreign-globals.ref.mixedcaseint3
+    *mixedcaseint3*
+  34567)
+
+(deftest foreign-globals.ref.mixed-case-int3
+    *mixed-case-int3*
+  45678)
+
+
+  
\ No newline at end of file

Added: branches/xml-class-rework/thirdparty/cffi/tests/funcall.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/tests/funcall.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/tests/funcall.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,173 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; funcall.lisp --- Tests function calling.
+;;;
+;;; Copyright (C) 2005, James Bielman  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+(in-package #:cffi-tests)
+
+;;;# Calling with Built-In C Types
+;;;
+;;; Tests calling standard C library functions both passing and
+;;; returning each built-in type.
+
+;;; Don't run these tests if the implementation does not support
+;;; foreign-funcall.
+#-cffi-features:no-foreign-funcall 
+(progn
+
+(deftest funcall.char
+    (foreign-funcall "toupper" :char (char-code #\a) :char)
+  #.(char-code #\A))
+
+(deftest funcall.int.1
+    (foreign-funcall "abs" :int -100 :int)
+  100)
+
+(defun funcall-abs (n)
+  (foreign-funcall "abs" :int n :int))
+
+;;; regression test: lispworks's %foreign-funcall based on creating
+;;; and chaching foreign-funcallables at macro-expansion time.
+(deftest funcall.int.2
+    (funcall-abs -42)
+  42)
+
+(deftest funcall.long
+    (foreign-funcall "labs" :long -131072 :long)
+  131072)
+
+#-cffi-features:no-long-long
+(deftest funcall.long-long
+    (foreign-funcall "my_llabs" :long-long -9223372036854775807 :long-long)
+  9223372036854775807)
+
+(deftest funcall.float
+    (foreign-funcall "my_sqrtf" :float 16.0 :float)
+  4.0)
+
+(deftest funcall.double
+    (foreign-funcall "sqrt" :double 36.0d0 :double)
+  6.0d0)
+
+#+(and scl long-float)
+(deftest funcall.long-double
+    (foreign-funcall "sqrtl" :long-double 36.0l0 :long-double)
+  6.0l0)
+
+(deftest funcall.string.1
+    (foreign-funcall "strlen" :string "Hello" :int)
+  5)
+
+(deftest funcall.string.2
+    (with-foreign-pointer-as-string (s 100)
+      (setf (mem-ref s :char) 0)
+      (foreign-funcall "strcpy" :pointer s :string "Hello" :pointer)
+      (foreign-funcall "strcat" :pointer s :string ", world!" :pointer))
+  "Hello, world!")
+
+(deftest funcall.string.3
+    (with-foreign-pointer (ptr 100)
+      (lisp-string-to-foreign "Hello, " ptr 8)
+      (foreign-funcall "strcat" :pointer ptr :string "world!" :string))
+  "Hello, world!")
+
+;;;# Calling Varargs Functions
+
+;; The CHAR argument must be passed as :INT because chars are promoted
+;; to ints when passed as variable arguments.
+(deftest funcall.varargs.char
+    (with-foreign-pointer-as-string (s 100)
+      (setf (mem-ref s :char) 0)
+      (foreign-funcall "sprintf" :pointer s :string "%c" :int 65 :int))
+  "A")
+
+(deftest funcall.varargs.int
+    (with-foreign-pointer-as-string (s 100)
+      (setf (mem-ref s :char) 0)
+      (foreign-funcall "sprintf" :pointer s :string "%d" :int 1000 :int))
+  "1000")
+
+(deftest funcall.varargs.long
+    (with-foreign-pointer-as-string (s 100)
+      (setf (mem-ref s :char) 0)
+      (foreign-funcall "sprintf" :pointer s :string "%ld" :long 131072 :int))
+  "131072")
+
+;;; There is no FUNCALL.VARARGS.FLOAT as floats are promoted to double
+;;; when passed as variable arguments.  Currently this fails in SBCL
+;;; and CMU CL on Darwin/ppc.
+(deftest funcall.varargs.double
+    (with-foreign-pointer-as-string (s 100)
+      (setf (mem-ref s :char) 0)
+      (foreign-funcall "sprintf" :pointer s :string "%.2f"
+                       :double (coerce pi 'double-float) :int))
+  "3.14")
+
+#+(and scl long-float)
+(deftest funcall.varargs.long-double
+    (with-foreign-pointer-as-string (s 100)
+      (setf (mem-ref s :char) 0)
+      (foreign-funcall "sprintf" :pointer s :string "%.2Lf"
+                       :long-double pi :int))
+  "3.14")
+
+(deftest funcall.varargs.string
+    (with-foreign-pointer-as-string (s 100)
+      (setf (mem-ref s :char) 0)
+      (foreign-funcall "sprintf" :pointer s :string "%s, %s!"
+                       :string "Hello" :string "world" :int))
+  "Hello, world!")
+
+;;; See DEFCFUN.DOUBLE26.
+(deftest funcall.double26
+    (foreign-funcall "sum_double26"
+                     :double 3.14d0 :double 3.14d0 :double 3.14d0
+                     :double 3.14d0 :double 3.14d0 :double 3.14d0
+                     :double 3.14d0 :double 3.14d0 :double 3.14d0
+                     :double 3.14d0 :double 3.14d0 :double 3.14d0
+                     :double 3.14d0 :double 3.14d0 :double 3.14d0
+                     :double 3.14d0 :double 3.14d0 :double 3.14d0
+                     :double 3.14d0 :double 3.14d0 :double 3.14d0
+                     :double 3.14d0 :double 3.14d0 :double 3.14d0
+                     :double 3.14d0 :double 3.14d0 :double)
+  81.64d0)
+
+;;; See DEFCFUN.FLOAT26.
+(deftest funcall.float26
+    (foreign-funcall "sum_float26"
+                     :float 5.0 :float 5.0 :float 5.0 :float 5.0 :float 5.0
+                     :float 5.0 :float 5.0 :float 5.0 :float 5.0 :float 5.0
+                     :float 5.0 :float 5.0 :float 5.0 :float 5.0 :float 5.0
+                     :float 5.0 :float 5.0 :float 5.0 :float 5.0 :float 5.0
+                     :float 5.0 :float 5.0 :float 5.0 :float 5.0 :float 5.0
+                     :float 5.0 :float)
+  130.0)
+
+;;; Funcalling a pointer.
+(deftest funcall.f-s-p.1
+    (foreign-funcall (foreign-symbol-pointer "abs") :int -42 :int)
+  42)
+
+) ;; #-cffi-features:no-foreign-funcall

Added: branches/xml-class-rework/thirdparty/cffi/tests/libtest.c
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/tests/libtest.c	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/tests/libtest.c	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,778 @@
+/* -*- Mode: C; tab-width: 4; indent-tabs-mode: nil -*-
+ *
+ * libtest.c --- auxiliary C lib for testing purposes
+ *
+ * Copyright (C) 2005, Luis Oliveira  
+ *
+ * Permission is hereby granted, free of charge, to any person
+ * obtaining a copy of this software and associated documentation
+ * files (the "Software"), to deal in the Software without
+ * restriction, including without limitation the rights to use, copy,
+ * modify, merge, publish, distribute, sublicense, and/or sell copies
+ * of the Software, and to permit persons to whom the Software is
+ * furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be
+ * included in all copies or substantial portions of the Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+ * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+ * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+ * NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+ * HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+ * DEALINGS IN THE SOFTWARE.
+ */
+
+#ifdef WIN32
+#define DLLEXPORT __declspec(dllexport)
+#else
+#define DLLEXPORT
+#endif
+
+#include 
+#include 
+#include 
+#include 
+#include 
+#include 
+
+/*
+ * Some functions that aren't avaiable on WIN32
+ */
+
+DLLEXPORT
+float my_sqrtf(float n)
+{
+    return (float) sqrt((double) n);
+}
+
+DLLEXPORT
+char *my_strdup(const char *str)
+{
+    char *p = malloc(strlen(str) + 1);
+    strcpy(p, str);
+    return p;
+}
+
+DLLEXPORT
+long long my_llabs(long long n)
+{
+    return n < 0 ? -n : n;
+}
+
+/*
+ * Foreign Globals
+ *
+ * (var_int is used in MISC-TYPES.EXPAND.3 as well)
+ */
+
+DLLEXPORT char *         dll_version        = "20060414";
+
+/* TODO: look into signed char vs. unsigned char issue */
+DLLEXPORT char           var_char           = -127;
+DLLEXPORT unsigned char  var_unsigned_char  = 255;
+DLLEXPORT short          var_short          = -32767;
+DLLEXPORT unsigned short var_unsigned_short = 65535;
+DLLEXPORT int            var_int            = -32767;
+DLLEXPORT unsigned int   var_unsigned_int   = 65535;
+DLLEXPORT long           var_long           = -2147483647L;
+DLLEXPORT unsigned long  var_unsigned_long  = 4294967295UL;
+DLLEXPORT float          var_float          = 42.0f;
+DLLEXPORT double         var_double         = 42.0;
+DLLEXPORT void *         var_pointer        = NULL;
+DLLEXPORT char *         var_string         = "Hello, foreign world!";
+
+DLLEXPORT long long          var_long_long          = -9223372036854775807LL;
+DLLEXPORT unsigned long long var_unsigned_long_long = 18446744073709551615ULL;
+
+DLLEXPORT float float_max = FLT_MAX;
+DLLEXPORT float float_min = FLT_MIN;
+DLLEXPORT double double_max = DBL_MAX;
+DLLEXPORT double double_min = DBL_MIN;
+
+/*
+ * Callbacks
+ */
+
+DLLEXPORT
+int expect_char_sum(char (*f)(char, char))
+{
+    return f('a', 3) == 'd';
+}
+
+DLLEXPORT
+int expect_unsigned_char_sum(unsigned char (*f)(unsigned char, unsigned char))
+{
+    return f(UCHAR_MAX-1, 1) == UCHAR_MAX;
+}
+
+DLLEXPORT
+int expect_short_sum(short (*f)(short a, short b))
+{
+    return f(SHRT_MIN+1, -1) == SHRT_MIN;
+}
+
+DLLEXPORT
+int expect_unsigned_short_sum(unsigned short (*f)(unsigned short,
+                                                  unsigned short))
+{
+    return f(USHRT_MAX-1, 1) == USHRT_MAX;
+}
+
+/* used in MISC-TYPES.EXPAND.4 as well */
+DLLEXPORT
+int expect_int_sum(int (*f)(int, int))
+{
+    return f(INT_MIN+1, -1) == INT_MIN;
+}
+
+DLLEXPORT
+int expect_unsigned_int_sum(unsigned int (*f)(unsigned int, unsigned int))
+{
+    return f(UINT_MAX-1, 1) == UINT_MAX;
+}
+
+DLLEXPORT
+int expect_long_sum(long (*f)(long, long))
+{
+    return f(LONG_MIN+1, -1) == LONG_MIN;
+}
+
+DLLEXPORT
+int expect_unsigned_long_sum(unsigned long (*f)(unsigned long, unsigned long))
+{
+    return f(ULONG_MAX-1, 1) == ULONG_MAX;
+}
+
+DLLEXPORT
+int expect_long_long_sum(long long (*f)(long long, long long))
+{
+    return f(LLONG_MIN+1, -1) == LLONG_MIN;
+}
+
+DLLEXPORT
+int expect_unsigned_long_long_sum (unsigned long long
+                                   (*f)(unsigned long long, unsigned long long))
+{
+    return f(ULLONG_MAX-1, 1) == ULLONG_MAX;
+}
+
+DLLEXPORT
+int expect_float_sum(float (*f)(float, float))
+{
+    /*printf("\n>>> FLOAT: %f <<<\n", f(20.0f, 22.0f));*/
+    return f(20.0f, 22.0f) == 42.0f;
+}
+
+DLLEXPORT
+int expect_double_sum(double (*f)(double, double))
+{
+    /*printf("\n>>> DOUBLE: %f<<<\n", f(-20.0, -22.0));*/
+    return f(-20.0, -22.0) == -42.0;
+}
+
+DLLEXPORT
+int expect_long_double_sum(long double (*f)(long double, long double))
+{
+    /*printf("\n>>> DOUBLE: %f<<<\n", f(-20.0, -22.0));*/
+    return f(-20.0, -22.0) == -42.0;
+}
+
+DLLEXPORT
+int expect_pointer_sum(void* (*f)(void*, int))
+{
+    return f(NULL, 0xDEAD) == (void *) 0xDEAD;
+}
+
+DLLEXPORT
+int expect_strcat(char* (*f)(char*, char*))
+{
+    char *ret = f("Hello, ", "C world!");
+    int res = strcmp(ret, "Hello, C world!") == 0;
+    /* commented out as a quick fix on platforms that don't
+       foreign allocate in C malloc space. */
+    /*free(ret);*/ /* is this allowed? */
+    return res;
+}
+
+DLLEXPORT
+void pass_int_ref(void (*f)(int*))
+{
+    int x = 1984;
+    f(&x);
+}
+
+/*
+ * Enums
+ */
+
+typedef enum {
+    ONE = 1,
+    TWO,
+    THREE,
+    FOUR,
+    FORTY_ONE = 41,
+    FORTY_TWO
+} numeros;
+
+DLLEXPORT
+int check_enums(numeros one, numeros two, numeros three, numeros four,
+                numeros forty_one, numeros forty_two)
+{
+    if (one == ONE && two == TWO && three == THREE && four == FOUR &&
+        forty_one == FORTY_ONE && forty_two == FORTY_TWO)
+        return 1;
+
+    return 0;
+}
+
+typedef enum { FALSE, TRUE } another_boolean;
+
+DLLEXPORT
+another_boolean return_enum(int x)
+{
+    if (x == 0)
+        return FALSE;
+    else
+        return TRUE;
+}
+
+/*
+ * Booleans
+ */
+
+DLLEXPORT
+int equalequal(int a, unsigned int b)
+{
+    return ((unsigned int) a) == b;
+}
+
+DLLEXPORT
+char bool_and(unsigned char a, char b)
+{
+    return a && b;
+}
+
+DLLEXPORT
+unsigned long bool_xor(long a, unsigned long b)
+{
+    return (a && !b) || (!a && b);
+}
+
+/*
+ * Test struct alignment issues. These comments assume the x86 gABI.
+ * Hopefully these tests will spot alignment issues in others archs
+ * too.
+ */
+
+/*
+ * STRUCT.ALIGNMENT.1
+ */
+
+struct s_ch {
+    char a_char;
+};
+
+/* This struct's size should be 2 bytes */
+struct s_s_ch {
+    char another_char;
+    struct s_ch a_s_ch; 
+};
+
+DLLEXPORT
+struct s_s_ch the_s_s_ch = { 2, { 1 } };
+
+/*
+ * STRUCT.ALIGNMENT.2
+ */
+
+/* This one should be alignment should be the same as short's alignment. */
+struct s_short {
+    char a_char;
+    char another_char;
+    short a_short;
+};
+
+struct s_s_short {
+    char yet_another_char;
+    struct s_short a_s_short; /* so this should be 2-byte aligned */
+};  /* size: 6 bytes */
+
+DLLEXPORT
+struct s_s_short the_s_s_short = { 4, { 1, 2, 3 } };
+
+/*
+ * STRUCT.ALIGNMENT.3
+ */
+
+/* This test will, among other things, check for the existence tail padding. */
+
+struct s_double {
+    char a_char;       /* 1 byte */
+                       /* padding: 3 bytes */
+    double a_double;   /* 8 bytes */
+    char another_char; /* 1 byte */
+                       /* padding: 3 bytes */
+};                     /* total size: 16 bytes */
+
+struct s_s_double {
+    char yet_another_char;      /* 1 byte */
+                                /* 3 bytes padding */
+    struct s_double a_s_double; /* 16 bytes */
+    short a_short;              /* 2 byte */
+                                /* 2 bytes padding */
+};                              /* total size: 24 bytes */
+
+DLLEXPORT
+struct s_s_double the_s_s_double = { 4, { 1, 2.0, 3 }, 5 };
+
+/*
+ * STRUCT.ALIGNMENT.4
+ */
+struct s_s_s_double {
+    short another_short;            /* 2 bytes */
+                                    /* 2 bytes padding */
+    struct s_s_double a_s_s_double; /* 24 bytes */
+    char last_char;                 /* 1 byte */
+                                    /* 3 bytes padding */
+};                                  /* total size: 32 */
+
+DLLEXPORT
+struct s_s_s_double the_s_s_s_double = { 6, { 4, { 1, 2.0, 3 }, 5 }, 7 };
+
+/*
+ * STRUCT.ALIGNMENT.5
+ */
+
+/* MacOSX ABI says: "The embedding alignment of the first element in a data
+   structure is equal to the element's natural alignment." and "For subsequent
+   elements that have a natural alignment greater than 4 bytes, the embedding
+   alignment is 4, unless the element is a vector." */
+
+/* note: these rules will apply to the structure itself. So, unless it is
+   the first element of another structure, its alignment will be 4. */
+
+/* the following offsets and sizes are specific to darwin/ppc32 */
+
+struct s_double2 {
+    double a_double;            /* 8 bytes (alignment 8) */
+    short a_short;              /* 2 bytes */
+                                /* 6 bytes padding */
+};                              /* total size: 16 */
+
+struct s_s_double2 {
+    char a_char;                  /* 1 byte */
+                                  /* 3 bytes padding */
+    struct s_double2 a_s_double2; /* 16 bytes, alignment 4 */
+    short another_short;          /* 2 bytes */
+                                  /* 2 bytes padding */
+};                                /* total size: 24 bytes */
+                                  /* alignment: 4 */
+
+DLLEXPORT
+struct s_s_double2 the_s_s_double2 = { 3, { 1.0, 2 }, 4 };
+
+/*
+ * STRUCT.ALIGNMENT.6
+ */
+
+/* Same as STRUCT.ALIGNMENT.5 but with long long. */
+
+struct s_long_long {
+    long long a_long_long;      /* 8 bytes (alignment 8) */
+    short a_short;              /* 2 bytes */
+                                /* 6 bytes padding */
+};                              /* total size: 16 */
+
+struct s_s_long_long {
+    char a_char;                      /* 1 byte */
+                                      /* 3 bytes padding */
+    struct s_long_long a_s_long_long; /* 16 bytes, alignment 4 */
+    short a_short;                    /* 2 bytes */
+                                      /* 2 bytes padding */
+};                                    /* total size: 24 bytes */
+                                      /* alignment: 4 */
+
+DLLEXPORT
+struct s_s_long_long the_s_s_long_long = { 3, { 1, 2 }, 4 };
+
+/*
+ * STRUCT.ALIGNMENT.7
+ */
+
+/* Another test for Darwin's PPC32 ABI. */
+
+struct s_s_double3 {
+    struct s_double2 a_s_double2; /* 16 bytes, alignment 8*/
+    short another_short;          /* 2 bytes */
+                                  /* 6 bytes padding */
+};                                /* total size: 24 */
+
+struct s_s_s_double3 {
+    struct s_s_double3 a_s_s_double3; /* 24 bytes */
+    char a_char;                      /* 1 byte */
+                                      /* 7 bytes padding */
+};                                    /* total size: 32 */
+
+DLLEXPORT
+struct s_s_s_double3 the_s_s_s_double3 = { { { 1.0, 2 }, 3 }, 4 };
+
+/* STRUCT.ALIGNMENT.x */
+
+/* commented this test out because this is not standard C
+   and MSVC++ (or some versions of it at least) won't compile it. */
+
+/*
+struct empty_struct {};
+
+struct with_empty_struct {
+    struct empty_struct foo;
+    int an_int;
+};
+
+DLLEXPORT
+struct with_empty_struct the_with_empty_struct = { {}, 42 };
+*/
+
+/*
+ * DEFCFUN.NOARGS and DEFCFUN.NOOP
+ */
+
+DLLEXPORT
+int noargs()
+{
+    return 42;
+}
+
+DLLEXPORT
+void noop()
+{
+    return;
+}
+
+/*
+ * DEFCFUN.BFF.1
+ *
+ * (let ((rettype (find-type :long))
+ *       (arg-types (n-random-types-no-ll 127)))
+ *   (c-function rettype arg-types)
+ *   (gen-function-test rettype arg-types))
+ */
+
+DLLEXPORT long sum_127_no_ll
+  (long a1, unsigned long a2, short a3, unsigned short a4, float a5,
+   double a6, unsigned long a7, float a8, unsigned char a9, unsigned
+   short a10, short a11, unsigned long a12, double a13, long a14,
+   unsigned int a15, void* a16, unsigned int a17, unsigned short a18,
+   long a19, float a20, void* a21, float a22, int a23, int a24, unsigned
+   short a25, long a26, long a27, double a28, unsigned char a29, unsigned
+   int a30, unsigned int a31, int a32, unsigned short a33, unsigned int
+   a34, void* a35, double a36, double a37, long a38, short a39, unsigned
+   short a40, long a41, char a42, long a43, unsigned short a44, void*
+   a45, int a46, unsigned int a47, double a48, unsigned char a49,
+   unsigned char a50, float a51, int a52, unsigned short a53, double a54,
+   short a55, unsigned char a56, unsigned long a57, float a58, float a59,
+   float a60, void* a61, void* a62, unsigned int a63, unsigned long a64,
+   char a65, short a66, unsigned short a67, unsigned long a68, void* a69,
+   float a70, double a71, long a72, unsigned long a73, short a74,
+   unsigned int a75, unsigned short a76, int a77, unsigned short a78,
+   char a79, double a80, short a81, unsigned char a82, float a83, char
+   a84, int a85, double a86, unsigned char a87, int a88, unsigned long
+   a89, double a90, short a91, short a92, unsigned int a93, unsigned char
+   a94, float a95, long a96, float a97, long a98, long a99, int a100, int
+   a101, unsigned int a102, char a103, char a104, unsigned short a105,
+   unsigned int a106, unsigned short a107, unsigned short a108, int a109,
+   long a110, char a111, double a112, unsigned int a113, char a114, short
+   a115, unsigned long a116, unsigned int a117, short a118, unsigned char
+   a119, float a120, void* a121, double a122, int a123, long a124, char
+   a125, unsigned short a126, float a127)
+{
+    return (long) a1 + a2 + a3 + a4 + ((long) a5) + ((long) a6) + a7 +
+        ((long) a8) + a9 + a10 + a11 + a12 + ((long) a13) + a14 + a15 +
+        ((unsigned int) a16) + a17 + a18 + a19 + ((long) a20) +
+        ((unsigned int) a21) + ((long) a22) + a23 + a24 + a25 + a26 + a27 +
+        ((long) a28) + a29 + a30 + a31 + a32 + a33 + a34 + ((unsigned int) a35) +
+        ((long) a36) + ((long) a37) + a38 + a39 + a40 + a41 + a42 + a43 + a44 +
+        ((unsigned int) a45) + a46 + a47 + ((long) a48) + a49 + a50 +
+        ((long) a51) + a52 + a53 + ((long) a54) + a55 + a56 + a57 + ((long) a58) +
+        ((long) a59) + ((long) a60) + ((unsigned int) a61) +
+        ((unsigned int) a62) + a63 + a64 + a65 + a66 + a67 + a68 +
+        ((unsigned int) a69) + ((long) a70) + ((long) a71) + a72 + a73 + a74 +
+        a75 + a76 + a77 + a78 + a79 + ((long) a80) + a81 + a82 + ((long) a83) +
+        a84 + a85 + ((long) a86) + a87 + a88 + a89 + ((long) a90) + a91 + a92 +
+        a93 + a94 + ((long) a95) + a96 + ((long) a97) + a98 + a99 + a100 + a101 +
+        a102 + a103 + a104 + a105 + a106 + a107 + a108 + a109 + a110 + a111 +
+        ((long) a112) + a113 + a114 + a115 + a116 + a117 + a118 + a119 +
+        ((long) a120) + ((unsigned int) a121) + ((long) a122) + a123 + a124 +
+        a125 + a126 + ((long) a127);
+}
+
+/*
+ * DEFCFUN.BFF.2
+ *
+ * (let ((rettype (find-type :long-long))
+ *       (arg-types (n-random-types 127)))
+ *   (c-function rettype arg-types)
+ *   (gen-function-test rettype arg-types))
+ */
+
+DLLEXPORT long long sum_127
+  (void* a1, void* a2, float a3, unsigned long a4, void* a5, long long
+  a6, double a7, double a8, unsigned short a9, int a10, long long a11,
+  long a12, short a13, unsigned int a14, long a15, unsigned char a16,
+  int a17, double a18, short a19, short a20, long long a21, unsigned
+  int a22, unsigned short a23, short a24, void* a25, short a26,
+  unsigned short a27, unsigned short a28, int a29, long long a30,
+  void* a31, int a32, unsigned long a33, unsigned long a34, void* a35,
+  unsigned long long a36, float a37, int a38, short a39, void* a40,
+  unsigned long long a41, long long a42, unsigned long a43, unsigned
+  long a44, unsigned long long a45, unsigned long a46, char a47,
+  double a48, long a49, unsigned int a50, int a51, short a52, void*
+  a53, long a54, unsigned long long a55, int a56, unsigned short a57,
+  unsigned long long a58, float a59, void* a60, float a61, unsigned
+  short a62, unsigned long a63, float a64, unsigned int a65, unsigned
+  long long a66, void* a67, double a68, unsigned long long a69, double
+  a70, double a71, long long a72, void* a73, unsigned short a74, long
+  a75, void* a76, short a77, double a78, long a79, unsigned char a80,
+  void* a81, unsigned char a82, long a83, double a84, void* a85, int
+  a86, double a87, unsigned char a88, double a89, short a90, long a91,
+  int a92, long a93, double a94, unsigned short a95, unsigned int a96,
+  int a97, char a98, long long a99, double a100, float a101, unsigned
+  long a102, short a103, void* a104, float a105, long long a106, int
+  a107, long long a108, long long a109, double a110, unsigned long
+  long a111, double a112, unsigned long a113, char a114, char a115,
+  unsigned long a116, short a117, unsigned char a118, unsigned char
+  a119, int a120, int a121, float a122, unsigned char a123, unsigned
+  char a124, double a125, unsigned long long a126, char a127)
+{
+    return (long long) ((unsigned int) a1) + ((unsigned int) a2) + ((long) a3) +
+        a4 + ((unsigned int) a5) + a6 + ((long) a7) + ((long) a8) + a9 + a10 +
+        a11 + a12 + a13 + a14 + a15 + a16 + a17 + ((long) a18) + a19 + a20 +
+        a21 + a22 + a23 + a24 + ((unsigned int) a25) + a26 + a27 + a28 + a29 +
+        a30 + ((unsigned int) a31) + a32 + a33 + a34 + ((unsigned int) a35) +
+        a36 + ((long) a37) + a38 + a39 + ((unsigned int) a40) + a41 + a42 + a43 +
+        a44 + a45 + a46 + a47 + ((long) a48) + a49 + a50 + a51 + a52 +
+        ((unsigned int) a53) + a54 + a55 + a56 + a57 + a58 + ((long) a59) +
+        ((unsigned int) a60) + ((long) a61) + a62 + a63 + ((long) a64) + a65 + a66
+        + ((unsigned int) a67) + ((long) a68) + a69 + ((long) a70) + ((long) a71) +
+        a72 + ((unsigned int) a73) + a74 + a75 + ((unsigned int) a76) + a77 +
+        ((long) a78) + a79 + a80 + ((unsigned int) a81) + a82 + a83 + ((long) a84)
+        + ((unsigned int) a85) + a86 + ((long) a87) + a88 + ((long) a89) + a90 +
+        a91 + a92 + a93 + ((long) a94) + a95 + a96 + a97 + a98 + a99 +
+        ((long) a100) + ((long) a101) + a102 + a103 + ((unsigned int) a104) +
+        ((long) a105) + a106 + a107 + a108 + a109 + ((long) a110) + a111 +
+        ((long) a112) + a113 + a114 + a115 + a116 + a117 + a118 + a119 + a120 +
+        a121 + ((long) a122) + a123 + a124 + ((long) a125) + a126 + a127;
+}
+
+/*
+ * CALLBACKS.BFF.1  (cb-test :no-long-long t)
+ */
+
+DLLEXPORT long call_sum_127_no_ll
+  (long (*func)
+   (unsigned long, void*, long, double, unsigned long, float, float,
+    int, unsigned int, double, double, double, void*, unsigned short,
+    unsigned short, void*, long, long, int, short, unsigned short,
+    unsigned short, char, long, void*, void*, char, unsigned char,
+    unsigned long, short, int, int, unsigned char, short, long, long,
+    void*, unsigned short, char, double, unsigned short, void*, short,
+    unsigned long, unsigned short, float, unsigned char, short, float,
+    short, char, unsigned long, unsigned long, char, float, long, void*,
+    short, float, unsigned int, float, unsigned int, double, unsigned int,
+    unsigned char, int, long, char, short, double, int, void*, char,
+    unsigned short, void*, unsigned short, void*, unsigned long, double,
+    void*, long, float, unsigned short, unsigned short, void*, float, int,
+    unsigned int, double, float, long, void*, unsigned short, float,
+    unsigned char, unsigned char, float, unsigned int, float, unsigned
+    short, double, unsigned short, unsigned long, unsigned int, unsigned
+    long, void*, unsigned char, char, char, unsigned short, unsigned long,
+    float, short, void*, long, unsigned short, short, double, short, int,
+    char, unsigned long, long, int, void*, double, unsigned char))
+{
+    return
+        func(948223085, (void *) 803308438, -465723152, 20385,
+             219679466, -10035, 13915, -1193455756, 1265303699, 27935, -18478,
+             -10508, (void *) 215389089, 55561, 55472, (void *) 146070433,
+             -1040819989, -17851453, -1622662247, -19473, 20837, 30216, 79,
+             986800400, (void *) 390281604, (void *) 1178532858, 19, 117,
+             78337699, -5718, -991300738, 872160910, 184, 926, -1487245383,
+             1633973783, (void *) 33738609, 53985, -116, 31645, 27196, (void *)
+             145569903, -6960, 17252220, 47404, -10491, 88, -30438, -21212,
+             -1982, -16, 1175270, 7949380, -121, 8559, -432968526, (void *)
+             293455312, 11894, -8394, 142421516, -25758, 3422998, 4004,
+             15758212, 198, -1071899743, -1284904617, -11, -17219, -30039,
+             311589092, (void *) 541468577, 123, 63517, (void *) 1252504506,
+             39368, (void *) 10057868, 134781408, -7143, (void *) 72825877,
+             -1190798667, -30862, 63757, 14965, (void *) 802391252, 22008,
+             -517289619, 806091099, 1125, 451, -498145176, (void *) 55960931,
+             15379, 4629, 184, 254, 22532, 465856451, -1669, 49416, -16546,
+             2983, 4337541, 65292495, 39253529, (void *) 669025, 211, 85, -19,
+             24298, 65358, 16776, -29957, (void *) 124311, -163231228, 2610,
+             -7806, 26434, -21913, -753615541, 120, 358697932, -1198889034,
+             -2131350926, (void *) 3749492036, -13413, 17);
+}
+
+/*
+ * CALLBACKS.BFF.2  (cb-test)
+ */
+
+DLLEXPORT long long call_sum_127
+  (long long (*func)
+   (short, char, void*, float, long, double, unsigned long long,
+    unsigned short, unsigned char, char, char, unsigned short, unsigned
+    long long, unsigned short, long long, unsigned short, unsigned long
+    long, unsigned char, unsigned char, unsigned long long, long long,
+    char, float, unsigned int, float, float, unsigned int, float, char,
+    unsigned char, long, long long, unsigned char, double, long,
+    double, unsigned int, unsigned short, long long, unsigned int, int,
+    unsigned long long, long, short, unsigned int, unsigned int,
+    unsigned long long, unsigned int, long, void*, unsigned char, char,
+    long long, unsigned short, unsigned int, float, unsigned char,
+    unsigned long, long long, float, long, float, int, float, unsigned
+    short, unsigned long long, short, unsigned long, long, char,
+    unsigned short, long long, short, double, void*, unsigned int,
+    char, unsigned int, void*, void*, unsigned char, void*, unsigned
+    short, unsigned char, long, void*, char, long, unsigned short,
+    unsigned char, double, unsigned long long, unsigned short, unsigned
+    short, unsigned int, long, char, long, char, short, unsigned short,
+    unsigned long, unsigned long, short, long long, long long, long
+    long, double, unsigned short, unsigned char, short, unsigned char,
+    long, long long, unsigned long long, unsigned int, unsigned long,
+    unsigned char, long long, unsigned char, unsigned long long,
+    double, unsigned char, long long, unsigned char, char, long long))
+{
+    return
+        func(-8573, 14, (void *) 832601021, -32334, -1532040888,
+             -18478, 2793023182591311826, 2740, 230, 103, 97, 13121,
+             5112369026351511084, 7763, -8134147951003417418, 34348,
+             5776613699556468853, 19, 122, 1431603726926527625,
+             439503521880490337, -112, -21557, 1578969190, -22008, -4953,
+             2127745975, -7262, -6, 180, 226352974, -3928775366167459219, 134,
+             -17730, -1175042526, 23868, 3494181009, 57364,
+             3134876875147518682, 104531655, -1286882727, 803577887579693487,
+             1349268803, 24912, 3313099419, 3907347884, 1738833249233805034,
+             2794230885, 1008818752, (void *) 1820044575, 189, 61,
+             -931654560961745071, 57531, 3096859985, 10405, 220, 3631311224,
+             -8531370353478907668, 31258, 678896693, -32150, -1869057813,
+             -19877, 62841, 4161660185772906873, -23869, 4016251006, 610353435,
+             105, 47315, -1051054492535331660, 6846, -15163, (void *)
+             736672359, 2123928476, -122, 3859258652, (void *) 3923394833,
+             (void *) 1265031970, 161, (void *) 1993867800, 55056, 122,
+             1562112760, (void *) 866615125, -79, -1261399547, 31737, 254,
+             -31279, 5462649659172897980, 5202, 7644, 174224940, -337854382,
+             -45, -583502442, -37, -13266, 24520, 2198606699, 2890453969,
+             -8282, -2295716637858246075, -1905178488651598878,
+             -6384652209316714643, 14841, 35443, 132, 15524, 187, 2138878229,
+             -5153032566879951000, 9056545530140684207, 4124632010, 276167701,
+             56, -2307310370663738730, 66, 9113015627153789746, -9618, 167,
+             755753399701306200, 119, -28, -990561962725435433);
+}
+
+/*
+ * CALLBACKS.DOUBLE26
+ */
+
+DLLEXPORT double call_double26
+  (double (*f)(double, double, double, double, double, double, double, double,
+               double, double, double, double, double, double, double, double,
+               double, double, double, double, double, double, double, double,
+               double, double))
+{
+    return f(3.14, 3.14, 3.14, 3.14, 3.14, 3.14, 3.14, 3.14, 3.14, 3.14, 3.14,
+             3.14, 3.14, 3.14, 3.14, 3.14, 3.14, 3.14, 3.14, 3.14, 3.14, 3.14,
+             3.14, 3.14, 3.14, 3.14);
+}
+
+/*
+ * DEFCFUN.DOUBLE26 and FUNCALL.DOUBLE26
+ */
+
+DLLEXPORT
+double sum_double26(double a1, double a2, double a3, double a4, double a5,
+                    double a6, double a7, double a8, double a9, double a10,
+                    double a11, double a12, double a13, double a14, double a15,
+                    double a16, double a17, double a18, double a19, double a20,
+                    double a21, double a22, double a23, double a24, double a25,
+                    double a26)
+{
+    return a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 + a10 + a11 + a12 + a13 +
+        a14 + a15 + a16 + a17 + a18 + a19 + a20 + a21 + a22 + a23 + a24 + a25 +
+        a26;
+}
+
+/*
+ * CALLBACKS.FLOAT26
+ */
+
+DLLEXPORT float call_float26
+  (float (*f)(float, float, float, float, float, float, float, float,
+              float, float, float, float, float, float, float, float,
+              float, float, float, float, float, float, float, float,
+              float, float))
+{
+    return f(5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0,
+             5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0,
+             5.0, 5.0, 5.0, 5.0);
+}
+
+/*
+ * DEFCFUN.FLOAT26 and FUNCALL.FLOAT26
+ */
+
+DLLEXPORT
+float sum_float26(float a1, float a2, float a3, float a4, float a5,
+                  float a6, float a7, float a8, float a9, float a10,
+                  float a11, float a12, float a13, float a14, float a15,
+                  float a16, float a17, float a18, float a19, float a20,
+                  float a21, float a22, float a23, float a24, float a25,
+                  float a26)
+{
+    return a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 + a10 + a11 + a12 + a13 +
+        a14 + a15 + a16 + a17 + a18 + a19 + a20 + a21 + a22 + a23 + a24 + a25 +
+        a26;
+}
+
+/*
+ * Symbol case.
+ */
+
+DLLEXPORT int UPPERCASEINT1    = 12345;
+DLLEXPORT int UPPER_CASE_INT1  = 23456;
+DLLEXPORT int MiXeDCaSeInT1    = 34567;
+DLLEXPORT int MiXeD_CaSe_InT1  = 45678;
+
+DLLEXPORT int UPPERCASEINT2    = 12345;
+DLLEXPORT int UPPER_CASE_INT2  = 23456;
+DLLEXPORT int MiXeDCaSeInT2    = 34567;
+DLLEXPORT int MiXeD_CaSe_InT2  = 45678;
+
+DLLEXPORT int UPPERCASEINT3    = 12345;
+DLLEXPORT int UPPER_CASE_INT3  = 23456;
+DLLEXPORT int MiXeDCaSeInT3    = 34567;
+DLLEXPORT int MiXeD_CaSe_InT3  = 45678;
+
+/*
+ * FOREIGN-SYMBOL-POINTER.1
+ */
+
+DLLEXPORT int compare_against_abs(intptr_t p)
+{
+    return p == (intptr_t) abs;
+}
+
+/*
+ * FOREIGN-SYMBOL-POINTER.2
+ */
+
+DLLEXPORT void xpto_fun() {}
+
+DLLEXPORT int compare_against_xpto_fun(intptr_t p)
+{
+    return p == (intptr_t) xpto_fun;
+}
+
+/* vim: ts=4 et
+*/


Property changes on: branches/xml-class-rework/thirdparty/cffi/tests/libtest.c
___________________________________________________________________
Name: svn:eol-style
   + native

Added: branches/xml-class-rework/thirdparty/cffi/tests/memory.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/tests/memory.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/tests/memory.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,513 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; memory.lisp --- Tests for memory referencing.
+;;;
+;;; Copyright (C) 2005, James Bielman  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+(in-package #:cffi-tests)
+
+(deftest deref.char
+    (with-foreign-object (p :char)
+      (setf (mem-ref p :char) -127)
+      (mem-ref p :char))
+  -127)
+
+(deftest deref.unsigned-char
+    (with-foreign-object (p :unsigned-char)
+      (setf (mem-ref p :unsigned-char) 255)
+      (mem-ref p :unsigned-char))
+  255)
+
+(deftest deref.short
+    (with-foreign-object (p :short)
+      (setf (mem-ref p :short) -32767)
+      (mem-ref p :short))
+  -32767)
+
+(deftest deref.unsigned-short
+    (with-foreign-object (p :unsigned-short)
+      (setf (mem-ref p :unsigned-short) 65535)
+      (mem-ref p :unsigned-short))
+  65535)
+
+(deftest deref.int
+    (with-foreign-object (p :int)
+      (setf (mem-ref p :int) -131072)
+      (mem-ref p :int))
+  -131072)
+
+(deftest deref.unsigned-int
+    (with-foreign-object (p :unsigned-int)
+      (setf (mem-ref p :unsigned-int) 262144)
+      (mem-ref p :unsigned-int))
+  262144)
+
+(deftest deref.long
+    (with-foreign-object (p :long)
+      (setf (mem-ref p :long) -536870911)
+      (mem-ref p :long))
+  -536870911)
+
+(deftest deref.unsigned-long
+    (with-foreign-object (p :unsigned-long)
+      (setf (mem-ref p :unsigned-long) 536870912)
+      (mem-ref p :unsigned-long))
+  536870912)
+
+#-cffi-features:no-long-long
+(progn
+  #+(and cffi-features:darwin openmcl)
+  (pushnew 'deref.long-long rt::*expected-failures*)
+
+  (deftest deref.long-long
+      (with-foreign-object (p :long-long)
+        (setf (mem-ref p :long-long) -9223372036854775807)
+        (mem-ref p :long-long))
+    -9223372036854775807)
+
+  (deftest deref.unsigned-long-long
+      (with-foreign-object (p :unsigned-long-long)
+        (setf (mem-ref p :unsigned-long-long) 18446744073709551615)
+        (mem-ref p :unsigned-long-long))
+    18446744073709551615))
+
+(deftest deref.float.1
+    (with-foreign-object (p :float)
+      (setf (mem-ref p :float) 0.0)
+      (mem-ref p :float))
+  0.0)
+
+(deftest deref.float.2
+    (with-foreign-object (p :float)
+      (setf (mem-ref p :float) *float-max*)
+      (mem-ref p :float))
+  #.*float-max*)
+
+(deftest deref.float.3
+    (with-foreign-object (p :float)
+      (setf (mem-ref p :float) *float-min*)
+      (mem-ref p :float))
+  #.*float-min*)
+
+(deftest deref.double.1
+    (with-foreign-object (p :double)
+      (setf (mem-ref p :double) 0.0d0)
+      (mem-ref p :double))
+  0.0d0)
+
+(deftest deref.double.2
+    (with-foreign-object (p :double)
+      (setf (mem-ref p :double) *double-max*)
+      (mem-ref p :double))
+  #.*double-max*)
+
+(deftest deref.double.3
+    (with-foreign-object (p :double)
+      (setf (mem-ref p :double) *double-min*)
+      (mem-ref p :double))
+  #.*double-min*)
+
+;;; TODO: use something like *DOUBLE-MIN/MAX* above once we actually
+;;; have an available lisp that supports long double.
+;#-cffi-features:no-long-float
+#+(and scl long-double)
+(progn
+  (deftest deref.long-double.1
+      (with-foreign-object (p :long-double)
+        (setf (mem-ref p :long-double) 0.0l0)
+        (mem-ref p :long-double))
+    0.0l0)
+
+  (deftest deref.long-double.2
+      (with-foreign-object (p :long-double)
+        (setf (mem-ref p :long-double) most-positive-long-float)
+        (mem-ref p :long-double))
+    #.most-positive-long-float)
+
+  (deftest deref.long-double.3
+      (with-foreign-object (p :long-double)
+        (setf (mem-ref p :long-double) least-positive-long-float)
+        (mem-ref p :long-double))
+    #.least-positive-long-float))
+
+;;; make sure the lisp doesn't convert NULL to NIL
+(deftest deref.pointer.null
+    (with-foreign-object (p :pointer)
+      (setf (mem-ref p :pointer) (null-pointer))
+      (null-pointer-p (mem-ref p :pointer)))
+  t)
+
+;;; regression test. lisp-string-to-foreign should handle empty strings
+(deftest lisp-string-to-foreign.empty
+    (with-foreign-pointer (str 2)
+      (setf (mem-ref str :unsigned-char) 42)
+      (lisp-string-to-foreign "" str 1)
+      (mem-ref str :unsigned-char))
+  0)
+
+;; regression test. with-foreign-pointer shouldn't evaluate
+;; the size argument twice.
+(deftest with-foreign-pointer.evalx2
+    (let ((count 0))
+      (with-foreign-pointer (x (incf count) size-var)
+        (values count size-var)))
+  1 1)
+
+(deftest mem-ref.left-to-right
+    (let ((i 0))
+      (with-foreign-object (p :char 3)
+        (setf (mem-ref p :char 0) 66 (mem-ref p :char 1) 92)
+        (setf (mem-ref p :char (incf i)) (incf i))
+        (values (mem-ref p :char 0) (mem-ref p :char 1) i)))
+  66 2 2)
+
+;;; This needs to be in a real function for at least Allegro CL or the
+;;; compiler macro on %MEM-REF is not expanded and the test doesn't
+;;; actually test anything!
+(defun %mem-ref-left-to-right ()
+  (let ((result nil))
+    (with-foreign-object (p :char)
+      (%mem-set 42 p :char)
+      (%mem-ref (progn (push 1 result) p) :char (progn (push 2 result) 0))
+      (nreverse result))))
+
+;;; Test left-to-right evaluation of the arguments to %MEM-REF when
+;;; optimized by the compiler macro.
+(deftest %mem-ref.left-to-right
+    (%mem-ref-left-to-right)
+  (1 2))
+
+;;; This needs to be in a top-level function for at least Allegro CL
+;;; or the compiler macro on %MEM-SET is not expanded and the test
+;;; doesn't actually test anything!
+(defun %mem-set-left-to-right ()
+  (let ((result nil))
+    (with-foreign-object (p :char)
+      (%mem-set (progn (push 1 result) 0)
+                (progn (push 2 result) p)
+                :char
+                (progn (push 3 result) 0))
+      (nreverse result))))
+
+;;; Test left-to-right evaluation of the arguments to %MEM-SET when
+;;; optimized by the compiler macro.
+(deftest %mem-set.left-to-right
+    (%mem-set-left-to-right)
+  (1 2 3))
+
+;; regression test. mem-aref's setf expansion evaluated its type argument twice.
+(deftest mem-aref.eval-type-x2
+    (let ((count 0))
+      (with-foreign-pointer (p 1)
+        (setf (mem-aref p (progn (incf count) :char) 0) 127))
+      count)
+  1)
+
+(deftest mem-aref.left-to-right
+    (let ((count -1))
+      (with-foreign-pointer (p 2)
+        (values
+         (setf (mem-aref p (progn (incf count) :char) (incf count)) (incf count))
+         (setq count -1)
+         (mem-aref (progn (incf count) p) :char (incf count))
+         count)))
+  2 -1 2 1)
+
+;; regression tests. nested mem-ref's and mem-aref's had bogus getters
+(deftest mem-ref.nested
+    (with-foreign-object (p :pointer)
+      (with-foreign-object (i :int)
+        (setf (mem-ref p :pointer) i)
+        (setf (mem-ref i :int) 42)
+        (setf (mem-ref (mem-ref p :pointer) :int) 1984)
+        (mem-ref i :int)))
+  1984)
+
+(deftest mem-aref.nested
+    (with-foreign-object (p :pointer)
+      (with-foreign-object (i :int 2)
+        (setf (mem-aref p :pointer 0) i)
+        (setf (mem-aref i :int 1) 42)
+        (setf (mem-aref (mem-ref p :pointer 0) :int 1) 1984)
+        (mem-aref i :int 1)))
+  1984)
+
+;;; regression tests. dereferencing an aggregate type. dereferencing a
+;;; struct should return a pointer to the struct itself, not return the
+;;; first 4 bytes (or whatever the size of :pointer is) as a pointer.
+;;;
+;;; This important for accessing an array of structs, which is
+;;; what the deref.array-of-aggregates test does.
+(defcstruct some-struct (x :int))
+
+(deftest deref.aggregate
+    (with-foreign-object (s 'some-struct)
+      (pointer-eq s (mem-ref s 'some-struct)))
+  t)
+
+(deftest deref.array-of-aggregates
+    (with-foreign-object (arr 'some-struct 3)
+      (loop for i below 3
+            do (setf (foreign-slot-value (mem-aref arr 'some-struct i)
+                                         'some-struct 'x)
+                     112))
+      (loop for i below 3
+            collect (foreign-slot-value (mem-aref arr 'some-struct i)
+                                        'some-struct 'x)))
+  (112 112 112))
+
+;;; pointer operations
+(deftest pointer.1
+    (pointer-address (make-pointer 42))
+  42)
+
+;;; I suppose this test is not very good. --luis
+(deftest pointer.2
+    (pointer-address (null-pointer))
+  0)
+
+;;; Ensure that a pointer to the highest possible address can be
+;;; created using MAKE-POINTER.  Regression test for CLISP/X86-64.
+(deftest make-pointer.high
+    (let* ((pointer-length (foreign-type-size :pointer))
+           (high-address (1- (expt 2 (* pointer-length 8))))
+           (pointer (make-pointer high-address)))
+      (- high-address (pointer-address pointer)))
+  0)
+
+;;; Ensure that incrementing a pointer by zero bytes returns an
+;;; equivalent pointer.
+(deftest inc-pointer.zero
+    (with-foreign-object (x :int)
+      (pointer-eq x (inc-pointer x 0)))
+  t)
+
+;;; Test the INITIAL-ELEMENT keyword argument to FOREIGN-ALLOC.
+(deftest foreign-alloc.1
+    (let ((ptr (foreign-alloc :int :initial-element 42)))
+      (unwind-protect
+           (mem-ref ptr :int)
+        (foreign-free ptr)))
+  42)
+
+;;; Test the INITIAL-ELEMENT and COUNT arguments to FOREIGN-ALLOC.
+(deftest foreign-alloc.2
+    (let ((ptr (foreign-alloc :int :count 4 :initial-element 100)))
+      (unwind-protect
+           (loop for i from 0 below 4
+                 collect (mem-aref ptr :int i))
+        (foreign-free ptr)))
+  (100 100 100 100))
+
+;;; Test the INITIAL-CONTENTS and COUNT arguments to FOREIGN-ALLOC,
+;;; passing a list of initial values.
+(deftest foreign-alloc.3
+    (let ((ptr (foreign-alloc :int :count 4 :initial-contents '(4 3 2 1))))
+      (unwind-protect
+           (loop for i from 0 below 4
+                 collect (mem-aref ptr :int i))
+        (foreign-free ptr)))
+  (4 3 2 1))
+
+;;; Test INITIAL-CONTENTS and COUNT with FOREIGN-ALLOC passing a
+;;; vector of initial values.
+(deftest foreign-alloc.4
+    (let ((ptr (foreign-alloc :int :count 4 :initial-contents #(10 20 30 40))))
+      (unwind-protect
+           (loop for i from 0 below 4
+                 collect (mem-aref ptr :int i))
+        (foreign-free ptr)))
+  (10 20 30 40))
+
+;;; Ensure calling FOREIGN-ALLOC with both INITIAL-ELEMENT and
+;;; INITIAL-CONTENTS signals an error.
+(deftest foreign-alloc.5
+    (values
+     (ignore-errors
+       (let ((ptr (foreign-alloc :int :initial-element 1 :initial-contents '(1))))
+         (foreign-free ptr))
+       t))
+  nil)
+
+;;; Regression test: FOREIGN-ALLOC shouldn't actually perform translation
+;;; on initial-element/initial-contents since MEM-AREF will do that already.
+(defctype not-an-int :int)
+
+(defmethod translate-to-foreign (value (name (eql 'not-an-int)))
+  (assert (not (integerp value)))
+  0)
+
+(deftest foreign-alloc.6
+    (let ((ptr (foreign-alloc 'not-an-int :initial-element 'foooo)))
+      (foreign-free ptr)
+      t)
+  t)
+
+;;; Ensure calling FOREIGN-ALLOC with NULL-TERMINATED-P and a non-pointer
+;;; type signals an error.
+(deftest foreign-alloc.7
+    (values
+     (ignore-errors
+       (let ((ptr (foreign-alloc :int :null-terminated-p t)))
+         (foreign-free ptr))
+       t))
+  nil)
+
+;;; The opposite of the above test.
+(defctype pointer-alias :pointer)
+
+(deftest foreign-alloc.8
+    (progn
+      (foreign-free (foreign-alloc 'pointer-alias :count 0 :null-terminated-p t))
+      t)
+  t)
+
+;;; Ensure calling FOREIGN-ALLOC with NULL-TERMINATED-P actually places
+;;; a null pointer at the end. Not a very reliable test apparently.
+(deftest foreign-alloc.9
+    (let ((ptr (foreign-alloc :pointer :count 0 :null-terminated-p t)))
+      (unwind-protect
+           (null-pointer-p (mem-ref ptr :pointer))
+        (foreign-free ptr)))
+  t)
+
+;;; Tests for mem-ref with a non-constant type. This is a way to test
+;;; the functional interface (without compiler macros).
+
+(deftest deref.nonconst.char
+    (let ((type :char))
+      (with-foreign-object (p type)
+        (setf (mem-ref p type) -127)
+        (mem-ref p type)))
+  -127)
+
+(deftest deref.nonconst.unsigned-char
+    (let ((type :unsigned-char))
+      (with-foreign-object (p type)
+        (setf (mem-ref p type) 255)
+        (mem-ref p type)))
+  255)
+
+(deftest deref.nonconst.short
+    (let ((type :short))
+      (with-foreign-object (p type)
+        (setf (mem-ref p type) -32767)
+        (mem-ref p type)))
+  -32767)
+
+(deftest deref.nonconst.unsigned-short
+    (let ((type :unsigned-short))
+      (with-foreign-object (p type)
+        (setf (mem-ref p type) 65535)
+        (mem-ref p type)))
+  65535)
+
+(deftest deref.nonconst.int
+    (let ((type :int))
+      (with-foreign-object (p type)
+        (setf (mem-ref p type) -131072)
+        (mem-ref p type)))
+  -131072)
+
+(deftest deref.nonconst.unsigned-int
+    (let ((type :unsigned-int))
+      (with-foreign-object (p type)
+        (setf (mem-ref p type) 262144)
+        (mem-ref p type)))
+  262144)
+
+(deftest deref.nonconst.long
+    (let ((type :long))
+      (with-foreign-object (p type)
+        (setf (mem-ref p type) -536870911)
+        (mem-ref p type)))
+  -536870911)
+
+(deftest deref.nonconst.unsigned-long
+    (let ((type :unsigned-long))
+      (with-foreign-object (p type)
+        (setf (mem-ref p type) 536870912)
+        (mem-ref p type)))
+  536870912)
+
+#-cffi-features:no-long-long
+(progn
+  #+(and cffi-features:darwin openmcl)
+  (pushnew 'deref.nonconst.long-long rt::*expected-failures*)
+
+  (deftest deref.nonconst.long-long
+      (let ((type :long-long))
+        (with-foreign-object (p type)
+          (setf (mem-ref p type) -9223372036854775807)
+          (mem-ref p type)))
+    -9223372036854775807)
+
+  (deftest deref.nonconst.unsigned-long-long
+      (let ((type :unsigned-long-long))
+        (with-foreign-object (p type)
+          (setf (mem-ref p type) 18446744073709551615)
+          (mem-ref p type)))
+    18446744073709551615))
+
+(deftest deref.nonconst.float.1
+    (let ((type :float))
+      (with-foreign-object (p type)
+        (setf (mem-ref p type) 0.0)
+        (mem-ref p type)))
+  0.0)
+
+(deftest deref.nonconst.float.2
+    (let ((type :float))
+      (with-foreign-object (p type)
+        (setf (mem-ref p type) *float-max*)
+        (mem-ref p type)))
+  #.*float-max*)
+
+(deftest deref.nonconst.float.3
+    (let ((type :float))
+      (with-foreign-object (p type)
+        (setf (mem-ref p type) *float-min*)
+        (mem-ref p type)))
+  #.*float-min*)
+
+(deftest deref.nonconst.double.1
+    (let ((type :double))
+      (with-foreign-object (p type)
+        (setf (mem-ref p type) 0.0d0)
+        (mem-ref p type)))
+  0.0d0)
+
+(deftest deref.nonconst.double.2
+    (let ((type :double))
+      (with-foreign-object (p type)
+        (setf (mem-ref p type) *double-max*)
+        (mem-ref p type)))
+  #.*double-max*)
+
+(deftest deref.nonconst.double.3
+    (let ((type :double))
+      (with-foreign-object (p type)
+        (setf (mem-ref p type) *double-min*)
+        (mem-ref p type)))
+  #.*double-min*)
\ No newline at end of file

Added: branches/xml-class-rework/thirdparty/cffi/tests/misc-types.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/tests/misc-types.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/tests/misc-types.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,233 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; misc-types.lisp --- Various tests on the type system.
+;;;
+;;; Copyright (C) 2005-2006, Luis Oliveira  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+(in-package #:cffi-tests)
+
+(defcfun ("my_strdup" strdup) :string+ptr (str :string))
+
+(deftest misc-types.string+ptr
+    (destructuring-bind (string pointer)
+        (strdup "foo")
+      (foreign-free pointer)
+      string)
+  "foo")
+
+(defcfun "equalequal" :boolean
+  (a (:boolean :int))
+  (b (:boolean :unsigned-int)))
+
+(defcfun "bool_and" (:boolean :char)
+  (a (:boolean :unsigned-char))
+  (b (:boolean :char)))
+
+(defcfun "bool_xor" (:boolean :unsigned-long)
+  (a (:boolean :long))
+  (b (:boolean :unsigned-long)))
+
+(deftest misc-types.boolean.1
+    (list (equalequal nil nil) 
+          (equalequal t t)
+          (equalequal t 23)
+          (bool-and 'a 'b)
+          (bool-and "foo" nil)
+          (bool-xor t nil)
+          (bool-xor nil nil))
+  (t t t t nil t nil))
+
+
+;;; Regression test: boolean type only worked with canonicalized
+;;; built-in integer types. Should work for any type that canonicalizes
+;;; to a built-in integer type.
+(defctype int-for-bool :int)
+(defcfun ("equalequal" equalequal2) :boolean
+  (a (:boolean int-for-bool))
+  (b (:boolean :uint)))
+
+(deftest misc-types.boolean.2
+    (equalequal2 nil t)
+  nil)
+
+(defctype my-string :string+ptr)
+
+(defun funkify (str)
+  (concatenate 'string "MORE " (string-upcase str)))
+
+(defun 3rd-person (value)
+  (list (concatenate 'string "Strdup says: " (first value))
+        (second value)))
+
+;; (defctype funky-string
+;;     (:wrapper my-string
+;;               :to-c #'funkify
+;;               :from-c (lambda (value)
+;;                         (list
+;;                          (concatenate 'string "Strdup says: "
+;;                                       (first value))
+;;                          (second value))))
+;;   "A useful type.")
+
+(defctype funky-string (:wrapper my-string :to-c funkify :from-c 3rd-person))
+
+(defcfun ("my_strdup" funky-strdup) funky-string
+  (str funky-string))
+
+(deftest misc-types.wrapper
+    (destructuring-bind (string ptr)
+        (funky-strdup "code")
+      (foreign-free ptr)
+      string)
+  "Strdup says: MORE CODE")
+
+(deftest misc-types.sized-ints
+    (mapcar #'foreign-type-size '(:int8 :uint8 :int16 :uint16 :int32 :uint32
+                                  #-cffi-features:no-long-long :int64
+                                  #-cffi-features:no-long-long :uint64))
+  (1 1 2 2 4 4
+   #-cffi-features:no-long-long 8
+   #-cffi-features:no-long-long 8))
+
+(defctype untranslated-int :int :translate-p nil)
+
+(defmethod translate-to-foreign (value (type (eql 'untranslated-int)))
+  (+ value 42))
+
+(defmethod translate-from-foreign (value (type (eql 'untranslated-int)))
+  (+ value 666))
+
+(defcfun ("abs" untranslated-abs) untranslated-int
+  (value untranslated-int))
+
+;;; Ensure that type translators are not called on non-translatable
+;;; typedefs when passing arguments or returning values to foreign
+;;; functions.
+(deftest misc-types.untranslated-typedef
+    (untranslated-abs 1)
+  1)
+
+;;; Ensure that type translators are not called on non-translatable
+;;; typedefs when passing values or returning from a callback.
+#-cffi-features:no-foreign-funcall
+(progn
+  (defcallback untranslated-callback untranslated-int ((x untranslated-int))
+    x)
+  (deftest misc-types.untranslated-callback
+      (foreign-funcall (callback untranslated-callback) :int 1 :int)
+    1))
+
+(defctype error-error :int)
+
+(defmethod translate-to-foreign (value (name (eql 'error-error)))
+  (declare (ignore value))
+  (error "translate-to-foreign invoked."))
+
+(defmethod translate-from-foreign (value (name (eql 'error-error)))
+  (declare (ignore value))
+  (error "translate-from-foreign invoked."))
+
+(eval-when (:load-toplevel :compile-toplevel :execute)
+  (defmethod expand-to-foreign (value (name (eql 'error-error)))
+    value)
+
+  (defmethod expand-from-foreign (value (name (eql 'error-error)))
+    value))
+
+(defcfun ("abs" expand-abs) error-error
+  (n error-error))
+
+(defcvar ("var_int" *expand-var-int*) error-error)
+
+(defcfun ("expect_int_sum" expand-expect-int-sum) :boolean
+  (cb :pointer))
+
+(defcallback expand-int-sum error-error ((x error-error) (y error-error))
+  (+ x y))
+
+;;; Ensure that macroexpansion-time translators are called where this
+;;; is guaranteed (defcfun, defcvar, foreign-funcall and defcallback)
+(deftest misc-types.expand.1
+    (expand-abs -1)
+  1)
+
+#-cffi-features:no-foreign-funcall
+(deftest misc-types.expand.2
+    (foreign-funcall "abs" error-error -1 error-error)
+  1)
+
+(deftest misc-types.expand.3
+    (let ((old (mem-ref (get-var-pointer '*expand-var-int*) :int)))
+      (unwind-protect
+           (progn
+             (setf *expand-var-int* 42)
+             *expand-var-int*)
+        (setf (mem-ref (get-var-pointer '*expand-var-int*) :int) old)))
+  42)
+
+(deftest misc-types.expand.4
+    (expand-expect-int-sum (callback expand-int-sum))
+  t)
+
+(defctype translate-tracker :int)
+
+(declaim (special .fto-called.))
+
+(defmethod free-translated-object (value (type-name (eql 'translate-tracker))
+                                   param)
+  (declare (ignore value param))
+  (setf .fto-called. t))
+
+(defctype expand-tracker :int)
+
+(defmethod free-translated-object (value (type-name (eql 'expand-tracker))
+                                   param)
+  (declare (ignore value param))
+  (setf .fto-called. t))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defmethod expand-to-foreign (value (type-name (eql 'expand-tracker)))
+    (declare (ignore value))
+    (call-next-method)))
+
+(defcfun ("abs" ttracker-abs) :int
+  (n translate-tracker))
+
+(defcfun ("abs" etracker-abs) :int
+  (n expand-tracker))
+
+;; free-translated-object must be called when there is no etf
+(deftest misc-types.expand.5
+    (let ((.fto-called. nil))
+      (ttracker-abs -1)
+      .fto-called.)
+  t)
+
+;; free-translated-object must not be called when there is an etf, but
+;; they answer *runtime-translator-form*
+(deftest misc-types.expand.6
+    (let ((.fto-called. nil))
+      (etracker-abs -1)
+      .fto-called.)
+  nil)

Added: branches/xml-class-rework/thirdparty/cffi/tests/misc.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/tests/misc.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/tests/misc.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,89 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; misc.lisp --- Miscellaneous tests.
+;;;
+;;; Copyright (C) 2006, Luis Oliveira  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+(in-package #:cffi-tests)
+
+;;; From CLRFI-1
+(defun featurep (feature-expression)
+  (etypecase feature-expression
+    (symbol (not (null (member feature-expression *features*))))
+    (cons                ; Not LIST, as we've already eliminated NIL.
+     (ecase (first feature-expression)
+       (:and (every #'featurep (rest feature-expression)))
+       (:or  (some #'featurep (rest feature-expression)))
+       (:not (not (featurep (cadr feature-expression))))))))
+
+;;; Test relations between OS features.
+
+(deftest features.os.1
+    (if (featurep 'cffi-features:windows)
+        (not (or (featurep 'cffi-features:unix)
+                 (featurep 'cffi-features:darwin)))
+        t)
+  t)
+
+(deftest features.os.2
+    (if (featurep 'cffi-features:darwin)
+        (and (not (featurep 'cffi-features:windows))
+             (featurep 'cffi-features:unix))
+        t)
+  t)
+
+(deftest features.os.3
+    (if (featurep 'cffi-features:unix)
+        (not (featurep 'cffi-features:windows))
+        t)
+  t)
+
+;;; Test mutual exclusiveness of CPU features.
+
+(defparameter *cpu-features*
+  '(cffi-features:x86
+    cffi-features:x86-64
+    cffi-features:ppc32))
+
+(deftest features.cpu.1
+    (loop for feature in *cpu-features*
+          when (featurep feature)
+          sum 1)
+  1)
+
+;;;; foreign-symbol-pointer tests
+
+;;; This might be useful for some libraries that compare function
+;;; pointers. http://thread.gmane.org/gmane.lisp.cffi.devel/694
+(defcfun "compare_against_abs" :boolean (p :pointer))
+
+(deftest foreign-symbol-pointer.1
+    (compare-against-abs (foreign-symbol-pointer "abs"))
+  t)
+
+(defcfun "compare_against_xpto_fun" :boolean (p :pointer))
+
+(deftest foreign-symbol-pointer.2
+    (compare-against-xpto-fun (foreign-symbol-pointer "xpto_fun"))
+  t)
\ No newline at end of file

Added: branches/xml-class-rework/thirdparty/cffi/tests/package.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/tests/package.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/tests/package.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,32 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; package.lisp --- CFFI-TESTS package definition.
+;;;
+;;; Copyright (C) 2005, James Bielman  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+(in-package #:cl-user)
+
+(defpackage #:cffi-tests
+  (:use #:cl #:cffi #:cffi-sys #:regression-test)
+  (:export #:do-tests))

Added: branches/xml-class-rework/thirdparty/cffi/tests/random-tester.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/tests/random-tester.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/tests/random-tester.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,246 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; random-tester.lisp --- Random test generator.
+;;;
+;;; Copyright (C) 2006, Luis Oliveira  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+;;; This code was used to generate the C and Lisp source code for
+;;; the CALLBACKS.BFF.[12] and DEFCFUN.BFF.[12] tests.
+;;;
+;;; The original idea was to test all combinations of argument types
+;;; but obviously as soon as you do the maths that it's not quite
+;;; feasable for more that 4 or 5 arguments.
+;;;
+;;; TODO: actually run random tests, ie compile/load/run the tests
+;;; this code can generate.
+
+(defpackage #:cffi-random-tester
+  (:use #:cl #:cffi #:regression-test))
+(in-package #:cffi-random-tester)
+
+(defstruct (c-type (:conc-name type-))
+  keyword
+  name
+  abbrev
+  min
+  max)
+
+(defparameter +types+
+  (mapcar (lambda (type)
+            (let ((keyword (first type))
+                  (name (second type)))
+              (multiple-value-bind (min max)
+                  ;; assume we can represent an integer in the range
+                  ;; [-2^16 2^16-1] in a float/double without causing
+                  ;; rounding errors (probably a lame assumption)
+                  (let ((type-size (if (or (eq keyword :float)
+                                           (eq keyword :double))
+                                       16
+                                       (* 8 (foreign-type-size keyword)))))
+                    (if (or (eql (char name 0) #\u) (eq keyword :pointer))
+                        (values 0 (1- (expt 2 type-size)))
+                        (values (- (expt 2 (1- type-size)))
+                                (1- (expt 2 (1- type-size))))))
+                (make-c-type :keyword keyword :name name :abbrev (third type)
+                             :min min :max max))))
+          '((:char "char" "c")
+            (:unsigned-char "unsigned char" "uc")
+            (:short "short" "s")
+            (:unsigned-short "unsigned short" "us")
+            (:int "int" "i")
+            (:unsigned-int "unsigned int" "ui")
+            (:long "long" "l")
+            (:unsigned-long "unsigned long" "ul")
+            (:float "float" "f")
+            (:double "double" "d")
+            (:pointer "void*" "p")
+            (:long-long "long long" "ll")
+            (:unsigned-long-long "unsigned long long" "ull"))))
+
+(defun find-type (keyword)
+  (find keyword +types+ :key #'type-keyword))
+
+(defun n-random-types (n)
+  (loop repeat n collect (nth (random (length +types+)) +types+)))
+
+;;; same as above, without the long long types
+(defun n-random-types-no-ll (n)
+  (loop repeat n collect (nth (random (- (length +types+) 2)) +types+)))
+
+(defun random-range (x y)
+  (+ x (random (+ (- y x) 2))))
+
+(defun random-sum (rettype arg-types)
+  "Returns a list of integers that fit in the respective types in the
+ARG-TYPES list and whose sum fits in RETTYPE."
+  (loop with sum = 0
+        for type in arg-types
+        for x = (random-range (max (- (type-min rettype) sum) (type-min type))
+                              (min (- (type-max rettype) sum) (type-max type)))
+        do (incf sum x)
+        collect x))
+
+(defun combinations (n items)
+  (let ((combs '()))
+    (labels ((rec (n accum)
+               (if (= n 0)
+                   (push accum combs)
+                   (loop for item in items
+                         do (rec (1- n) (cons item accum))))))
+      (rec n '())
+      combs)))
+
+(defun function-name (rettype arg-types)
+  (format nil "sum_~A_~{_~A~}"
+          (type-abbrev rettype)
+          (mapcar #'type-abbrev arg-types)))
+
+(defun c-function (rettype arg-types)
+  (let ((args (loop for type in arg-types and i from 1
+                    collect (list (type-name type) (format nil "a~A" i)))))
+    (format t "DLLEXPORT ~A ~A(~{~{~A ~A~}~^, ~})~%~
+               { return ~A(~A) ~{~A~^ + ~}~A; }"
+            (type-name rettype) (function-name rettype arg-types) args
+            (if (eq (type-keyword rettype) :pointer)
+                "(void *)((unsigned int)("
+                "")
+            (type-name rettype)
+            (loop for arg-pair in args collect
+                  (format nil "~A~A~A"
+                          (cond ((string= (first arg-pair) "void*")
+                                 "(unsigned int) ")
+                                ((or (string= (first arg-pair) "double")
+                                     (string= (first arg-pair) "float"))
+                                 "((int) ")
+                                (t ""))
+                          (second arg-pair)
+                          (if (member (first arg-pair)
+                                      '("void*" "double" "float")
+                                      :test #'string=)
+                              ")"
+                              "")))
+            (if (eq (type-keyword rettype) :pointer) "))" ""))))
+
+(defun c-callback (rettype arg-types args)
+  (format t "DLLEXPORT ~A call_~A(~A (*func)(~{~A~^, ~}~^))~%~
+             { return func(~{~A~^, ~}); }"
+          (type-name rettype) (function-name rettype arg-types)
+          (type-name rettype) (mapcar #'type-name arg-types)
+          (loop for type in arg-types and value in args collect
+                (format nil "~A~A"
+                        (if (eq (type-keyword type) :pointer)
+                            "(void *) "
+                            "")
+                        value))))
+
+;;; (output-c-code #p"generated.c" 3 5)
+(defun output-c-code (file min max)
+  (with-open-file (stream file :direction :output :if-exists :error)
+    (let ((*standard-output* stream))
+      (format t "/* automatically generated functions and callbacks */~%~%")
+      (loop for n from min upto max do
+            (format t "/* ~A args */" (1- n))
+            (loop for comb in (combinations n +types+) do
+                  (terpri) (c-function (car comb) (cdr comb))
+                  (terpri) (c-callback (car comb) (cdr comb)))))))
+
+(defmacro with-conversion (type form)
+  (case type
+    (:double `(float ,form 1.0d0))
+    (:float `(float ,form))
+    (:pointer `(make-pointer ,form))
+    (t form)))
+
+(defun integer-conversion (type form)
+  (case type
+    ((:double :float) `(values (floor ,form)))
+    (:pointer `(pointer-address ,form))
+    (t form)))
+
+(defun gen-arg-values (rettype arg-types)
+  (let ((numbers (random-sum rettype arg-types)))
+    (values
+     (reduce #'+ numbers)
+     (loop for type in arg-types and n in numbers
+           collect (case (type-keyword type)
+                     (:double (float n 1.0d0))
+                     (:float (float n))
+                     (:pointer `(make-pointer ,n))
+                     (t n))))))
+
+(defun gen-function-test (rettype arg-types)
+  (let* ((fun-name (function-name rettype arg-types))
+         (fun-sym (cffi::lisp-function-name fun-name)))
+    (multiple-value-bind (sum value-forms)
+        (gen-arg-values rettype arg-types)
+    `(progn
+       (defcfun (,fun-name ,fun-sym) ,(type-keyword rettype)
+         ,@(loop for type in arg-types and i from 1 collect
+                 (list (cffi-utils:symbolicate '#:a (format nil "~A" i))
+                       (type-keyword type))))
+       (deftest ,(cffi-utils:symbolicate '#:defcfun. fun-sym)
+           ,(integer-conversion (type-keyword rettype)
+                                `(,fun-sym , at value-forms))
+         ,sum)))))
+
+(defun gen-callback-test (rettype arg-types sum)
+  (let* ((fname (function-name rettype arg-types))
+         (cb-sym (cffi::lisp-function-name fname))
+         (fun-name (concatenate 'string "call_" fname))
+         (fun-sym (cffi::lisp-function-name fun-name))
+         (arg-names (loop for i from 1 upto (length arg-types) collect
+                          (cffi-utils:symbolicate '#:a (format nil "~A" i)))))
+    `(progn
+       (defcfun (,fun-name ,fun-sym) ,(type-keyword rettype) (cb :pointer))
+       (defcallback ,cb-sym ,(type-keyword rettype)
+           ,(loop for type in arg-types and name in arg-names
+                  collect (list name (type-keyword type)))
+         ,(integer-conversion
+           (type-keyword rettype)
+           `(+ ,@(mapcar (lambda (tp n)
+                           (integer-conversion (type-keyword tp) n))
+                         arg-types arg-names))))
+       (deftest ,(cffi-utils:symbolicate '#:callbacks. cb-sym)
+           ,(integer-conversion (type-keyword rettype)
+                                `(,fun-sym (callback ,cb-sym)))
+         ,sum))))
+
+(defun cb-test (&key no-long-long)
+  (let* ((rettype (find-type (if no-long-long :long :long-long)))
+         (arg-types (if no-long-long
+                        (n-random-types-no-ll 127)
+                        (n-random-types 127)))
+         (args (random-sum rettype arg-types))
+         (sum (reduce #'+ args)))
+    (c-callback rettype arg-types args)
+    (gen-callback-test rettype arg-types sum)))
+
+;; (defmacro define-function-and-callback-tests (min max)
+;;   `(progn
+;;      ,@(loop for n from min upto max appending
+;;              (loop for comb in (combinations n +types+)
+;;                    collect (gen-function-test (car comb) (cdr comb))
+;;                    collect (gen-callback-test (car comb) (cdr comb))))))
+
+;; (define-function-and-callback-tests 3 5)
\ No newline at end of file

Added: branches/xml-class-rework/thirdparty/cffi/tests/run-tests.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/tests/run-tests.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/tests/run-tests.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,54 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; run-tests.lisp --- Simple script to run the unit tests.
+;;;
+;;; Copyright (C) 2005, James Bielman  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+(format t "~&-------- Running tests in ~A --------~%"
+        (lisp-implementation-type))
+
+(setf *load-verbose* nil *compile-verbose* nil *compile-print* nil)
+#+cmu (setf ext:*gc-verbose* nil)
+
+#+(and (not asdf) (or sbcl openmcl ecl))
+(require "asdf")
+
+(asdf:operate 'asdf:load-op 'cffi-tests :verbose nil)
+(in-package #:cffi-tests)
+(do-tests)
+
+(defparameter *repeat* 0)
+(format t "~2&How many times shall we repeat the tests? [~D]: " *repeat*)
+(force-output *standard-output*)
+(let ((ntimes (or (ignore-errors (parse-integer (read-line))) *repeat*)))
+  (unless (eql ntimes 0)
+    (loop repeat ntimes do (do-tests))
+    (format t "~&Finished running tests ~D times." ntimes)))
+
+(in-package #:cl-user)
+(terpri)
+(force-output)
+
+#-allegro (quit)
+#+allegro (exit)

Added: branches/xml-class-rework/thirdparty/cffi/tests/struct.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/tests/struct.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/tests/struct.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,296 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; struct.lisp --- Foreign structure type tests.
+;;;
+;;; Copyright (C) 2005, James Bielman  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+(in-package #:cffi-tests)
+
+(defcstruct timeval
+  (tv-secs :long)
+  (tv-usecs :long))
+
+(defparameter *timeval-size* (* 2 (max (foreign-type-size :long)
+                                       (foreign-type-alignment :long))))
+
+;;;# Basic Structure Tests
+
+(deftest struct.1
+    (- (foreign-type-size 'timeval) *timeval-size*)
+  0)
+
+(deftest struct.2
+    (with-foreign-object (tv 'timeval)
+      (setf (foreign-slot-value tv 'timeval 'tv-secs) 0)
+      (setf (foreign-slot-value tv 'timeval 'tv-usecs) 1)
+      (values (foreign-slot-value tv 'timeval 'tv-secs)
+              (foreign-slot-value tv 'timeval 'tv-usecs)))
+  0 1)
+
+(deftest struct.3
+    (with-foreign-object (tv 'timeval)
+      (with-foreign-slots ((tv-secs tv-usecs) tv timeval)
+        (setf tv-secs 100 tv-usecs 200)
+        (values tv-secs tv-usecs)))
+  100 200)
+
+;; regression test: accessing a struct through a typedef
+
+(defctype xpto timeval)
+
+(deftest struct.4
+    (with-foreign-object (tv 'xpto)
+      (setf (foreign-slot-value tv 'xpto 'tv-usecs) 1)
+      (values (foreign-slot-value tv 'xpto 'tv-usecs)
+              (foreign-slot-value tv 'timeval 'tv-usecs)))
+  1 1)
+
+(deftest struct.names
+    (sort (foreign-slot-names 'xpto) #'<
+          :key (lambda (x) (foreign-slot-offset 'xpto x)))
+  (tv-secs tv-usecs))
+
+;; regression test: compiler macro not quoting the type in the
+;; resulting mem-ref form. The compiler macro on foreign-slot-value
+;; is not guaranteed to be expanded though.
+
+(defctype my-int :int)
+(defcstruct s5 (a my-int))
+
+(deftest struct.5
+    (with-foreign-object (s 's5)
+      (setf (foreign-slot-value s 's5 'a) 42)
+      (foreign-slot-value s 's5 'a))
+  42)
+
+;;;# Structs with type translators
+
+(defcstruct struct-string
+  (s :string))
+
+(deftest struct.string.1
+    (with-foreign-object (ptr 'struct-string)
+      (with-foreign-slots ((s) ptr struct-string)
+        (setf s "So long and thanks for all the fish!")
+        s))
+  "So long and thanks for all the fish!")
+
+(deftest struct.string.2
+    (with-foreign-object (ptr 'struct-string)
+      (setf (foreign-slot-value ptr 'struct-string 's) "Cha")
+      (foreign-slot-value ptr 'struct-string 's))
+  "Cha")
+
+;;;# Structure Alignment Tests
+;;;
+;;; See libtest.c and types.lisp for some comments about alignments.
+
+(defcstruct s-ch
+  (a-char :char))
+
+(defcstruct s-s-ch
+  (another-char :char)
+  (a-s-ch s-ch))
+
+(defcvar "the_s_s_ch" s-s-ch)
+
+(deftest struct.alignment.1
+    (list 'a-char (foreign-slot-value
+                   (foreign-slot-value *the-s-s-ch* 's-s-ch 'a-s-ch)
+                   's-ch 'a-char)
+          'another-char (foreign-slot-value *the-s-s-ch* 's-s-ch 'another-char))
+  (a-char 1 another-char 2))
+
+
+(defcstruct s-short
+  (a-char :char)
+  (another-char :char)
+  (a-short :short))
+
+(defcstruct s-s-short
+  (yet-another-char :char)
+  (a-s-short s-short))
+
+(defcvar "the_s_s_short" s-s-short)
+
+(deftest struct.alignment.2
+    (with-foreign-slots ((yet-another-char a-s-short) *the-s-s-short* s-s-short)
+      (with-foreign-slots ((a-char another-char a-short) a-s-short s-short)
+        (list 'a-char           a-char
+              'another-char     another-char
+              'a-short          a-short
+              'yet-another-char yet-another-char)))
+  (a-char 1 another-char 2 a-short 3 yet-another-char 4))
+
+
+(defcstruct s-double
+  (a-char :char)
+  (a-double :double)
+  (another-char :char))
+
+(defcstruct s-s-double
+  (yet-another-char :char)
+  (a-s-double s-double)
+  (a-short :short))
+
+(defcvar "the_s_s_double" s-s-double)
+
+(deftest struct.alignment.3
+    (with-foreign-slots
+        ((yet-another-char a-s-double a-short) *the-s-s-double* s-s-double)
+      (with-foreign-slots ((a-char a-double another-char) a-s-double s-double)
+        (list 'a-char            a-char
+              'a-double          a-double
+              'another-char      another-char
+              'yet-another-char  yet-another-char
+              'a-short           a-short)))
+  (a-char 1 a-double 2.0d0 another-char 3 yet-another-char 4 a-short 5))
+
+
+(defcstruct s-s-s-double
+  (another-short :short)
+  (a-s-s-double s-s-double)
+  (last-char :char))
+
+(defcvar "the_s_s_s_double" s-s-s-double)
+
+(deftest struct.alignment.4
+    (with-foreign-slots
+        ((another-short a-s-s-double last-char) *the-s-s-s-double* s-s-s-double)
+      (with-foreign-slots
+          ((yet-another-char a-s-double a-short) a-s-s-double s-s-double)
+        (with-foreign-slots ((a-char a-double another-char) a-s-double s-double)
+          (list 'a-char            a-char
+                'a-double          a-double
+                'another-char      another-char
+                'yet-another-char  yet-another-char
+                'a-short           a-short
+                'another-short     another-short
+                'last-char         last-char))))
+  (a-char 1 a-double 2.0d0 another-char 3 yet-another-char 4 a-short 5
+   another-short 6 last-char 7))
+
+
+(defcstruct s-double2
+  (a-double :double)
+  (a-short  :short))
+
+(defcstruct s-s-double2
+  (a-char        :char)
+  (a-s-double2   s-double2)
+  (another-short :short))
+
+(defcvar "the_s_s_double2" s-s-double2)
+
+(deftest struct.alignment.5
+    (with-foreign-slots
+        ((a-char a-s-double2 another-short) *the-s-s-double2* s-s-double2)
+      (with-foreign-slots ((a-double a-short) a-s-double2 s-double2)
+        (list 'a-double       a-double
+              'a-short        a-short
+              'a-char         a-char
+              'another-short  another-short)))
+  (a-double 1.0d0 a-short 2 a-char 3 another-short 4))
+
+
+#-cffi-features:no-long-long
+(progn
+  (defcstruct s-long-long
+    (a-long-long :long-long)
+    (a-short     :short))
+
+  (defcstruct s-s-long-long
+    (a-char        :char)
+    (a-s-long-long s-long-long)
+    (another-short :short))
+
+  (defcvar "the_s_s_long_long" s-s-long-long)
+
+  (deftest struct.alignment.6
+      (with-foreign-slots
+          ((a-char a-s-long-long another-short) *the-s-s-long-long* s-s-long-long)
+        (with-foreign-slots ((a-long-long a-short) a-s-long-long s-long-long)
+          (list 'a-long-long    a-long-long
+                'a-short        a-short
+                'a-char         a-char
+                'another-short  another-short)))
+    (a-long-long 1 a-short 2 a-char 3 another-short 4)))
+
+
+(defcstruct s-s-double3
+  (a-s-double2   s-double2)
+  (another-short :short))
+
+(defcstruct s-s-s-double3
+  (a-s-s-double3  s-s-double3)
+  (a-char         :char))
+
+(defcvar "the_s_s_s_double3" s-s-s-double3)
+
+(deftest struct.alignment.7
+    (with-foreign-slots ((a-s-s-double3 a-char) *the-s-s-s-double3* s-s-s-double3)
+      (with-foreign-slots ((a-s-double2 another-short) a-s-s-double3 s-s-double3)
+        (with-foreign-slots ((a-double a-short) a-s-double2 s-double2)
+          (list 'a-double      a-double
+                'a-short       a-short
+                'another-short another-short
+                'a-char        a-char))))
+  (a-double 1.0d0 a-short 2 another-short 3 a-char 4))
+
+
+(defcstruct empty-struct)
+
+(defcstruct with-empty-struct
+  (foo empty-struct)
+  (an-int :int))
+
+;; commented out this test because an empty struct is not valid/standard C
+;; left the struct declarations anyway because they should be handled
+;; gracefuly anyway.
+
+; (defcvar "the_with_empty_struct" with-empty-struct)
+;
+; (deftest struct.alignment.5
+;     (with-foreign-slots ((foo an-int) *the-with-empty-struct* with-empty-struct)
+;       an-int)
+;   42)
+
+
+;; regression test, setf-ing nested foreign-slot-value forms
+;; the setf expander used to return a bogus getter
+
+(defcstruct s1
+  (an-int :int))
+
+(defcstruct s2
+  (an-s1 s1))
+
+(deftest struct.nested-setf
+    (with-foreign-object (an-s2 's2) 
+      (setf (foreign-slot-value (foreign-slot-value an-s2 's2 'an-s1)
+                                's1 'an-int)
+            1984)
+      (foreign-slot-value (foreign-slot-value an-s2 's2 'an-s1)
+                          's1 'an-int))
+  1984)
\ No newline at end of file

Added: branches/xml-class-rework/thirdparty/cffi/tests/union.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/tests/union.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/tests/union.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,50 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; union.lisp --- Tests on C unions.
+;;;
+;;; Copyright (C) 2005, James Bielman  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+(in-package #:cffi-tests)
+
+(defcunion uint32-bytes
+  (int-value :unsigned-int)
+  (bytes :unsigned-char :count 4))
+
+(defun int-to-bytes (n)
+  "Convert N to a list of bytes using a union."
+  (with-foreign-object (obj 'uint32-bytes)
+    (setf (foreign-slot-value obj 'uint32-bytes 'int-value) n)
+    (loop for i from 0 below 4
+          collect (mem-aref
+                   (foreign-slot-value obj 'uint32-bytes 'bytes)
+                   :unsigned-char i))))
+
+(deftest union.1
+    (let ((bytes (int-to-bytes #x12345678)))
+      (cond ((equal bytes '(#x12 #x34 #x56 #x78))
+             t)
+            ((equal bytes '(#x78 #x56 #x34 #x12))
+             t)
+            (t bytes)))
+  t)

Added: branches/xml-class-rework/thirdparty/cffi/uffi-compat/uffi-compat.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/uffi-compat/uffi-compat.lisp	2006-10-21 16:14:15 UTC (rev 2022)
+++ branches/xml-class-rework/thirdparty/cffi/uffi-compat/uffi-compat.lisp	2006-10-22 15:57:04 UTC (rev 2023)
@@ -0,0 +1,619 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; uffi-compat.lisp --- UFFI compatibility layer for CFFI.
+;;;
+;;; Copyright (C) 2005, James Bielman  
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+;;;
+
+;;; Code borrowed from UFFI is Copyright (c) Kevin M. Rosenberg.
+
+(defpackage #:cffi-uffi-compat
+  (:nicknames #:uffi) ;; is this a good idea?
+  (:use #:cl)
+  (:export
+
+   ;; immediate types
+   #:def-constant
+   #:def-foreign-type
+   #:def-type
+   #:null-char-p
+   
+   ;; aggregate types
+   #:def-enum
+   #:def-struct
+   #:get-slot-value
+   #:get-slot-pointer
+   #:def-array-pointer
+   #:deref-array
+   #:def-union
+
+   ;; objects
+   #:allocate-foreign-object
+   #:free-foreign-object
+   #:with-foreign-object
+   #:with-foreign-objects
+   #:size-of-foreign-type
+   #:pointer-address
+   #:deref-pointer
+   #:ensure-char-character
+   #:ensure-char-integer
+   #:ensure-char-storable
+   #:null-pointer-p
+   #:make-null-pointer
+   #:make-pointer
+   #:+null-cstring-pointer+
+   #:char-array-to-pointer
+   #:with-cast-pointer
+   #:def-foreign-var
+   #:convert-from-foreign-usb8
+
+   ;; string functions
+   #:convert-from-cstring
+   #:convert-to-cstring
+   #:free-cstring
+   #:with-cstring
+   #:with-cstrings
+   #:convert-from-foreign-string
+   #:convert-to-foreign-string
+   #:allocate-foreign-string
+   #:with-foreign-string
+   #:with-foreign-strings
+   #:foreign-string-length              ; not implemented
+   
+   ;; function call
+   #:def-function
+
+   ;; libraries
+   #:find-foreign-library
+   #:load-foreign-library
+   #:default-foreign-library-type
+   #:foreign-library-types
+
+   ;; os
+   #:getenv
+   #:run-shell-command
+   ))
+
+(in-package #:cffi-uffi-compat)
+
+#+clisp
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (when (equal (machine-type) "POWER MACINTOSH")
+    (pushnew :ppc *features*)))
+
+(defun convert-uffi-type (uffi-type)
+  "Convert a UFFI primitive type to a CFFI type."
+  ;; Many CFFI types are the same as UFFI.  This list handles the
+  ;; exceptions only.
+  (case uffi-type
+    (:cstring :pointer)
+    (:pointer-void :pointer)
+    (:pointer-self :pointer)
+    (:char '(uffi-char :char))
+    (:unsigned-char '(uffi-char :unsigned-char))
+    (:byte :char)
+    (:unsigned-byte :unsigned-char)
+    (t
+     (if (listp uffi-type)
+         (case (car uffi-type)
+           ;; this is imho gross but it is what uffi does
+           (quote (convert-uffi-type (second uffi-type)))
+           (* :pointer)
+           (:array `(uffi-array ,(convert-uffi-type (second uffi-type))
+                                ,(third uffi-type)))
+           (:union (second uffi-type))
+           (:struct (convert-uffi-type (second uffi-type)))
+           (:struct-pointer :pointer))
+         uffi-type))))
+
+(defclass uffi-array-type (cffi::foreign-typedef)
+  ;; ELEMENT-TYPE should be /unparsed/, suitable for passing to mem-aref.
+  ((element-type :initform (error "An element-type is required.")
+                 :accessor element-type :initarg :element-type)
+   (nelems :initform (error "nelems is required.")
+           :accessor nelems :initarg :nelems))
+  (:documentation "UFFI's :array type."))
+
+(defmethod initialize-instance :after ((self uffi-array-type) &key)
+  (setf (cffi::actual-type self) (cffi::find-type :pointer)))
+
+(defmethod cffi:foreign-type-size ((type uffi-array-type))
+  (* (cffi:foreign-type-size (element-type type)) (nelems type)))
+
+(defmethod cffi::aggregatep ((type uffi-array-type))
+  t)
+
+(cffi::define-type-spec-parser uffi-array (element-type count)
+  (make-instance 'uffi-array-type :element-type element-type
+                 :nelems (or count 1)))
+
+;; UFFI's :(unsigned-)char
+(cffi:define-foreign-type uffi-char (base-type)
+  base-type)
+
+(defmethod cffi:translate-to-foreign ((value character) (name (eql 'uffi-char)))
+  (char-code value))
+
+(defmethod cffi:translate-from-foreign (obj (name (eql 'uffi-char)))
+  (code-char obj))
+
+(defmacro def-type (name type)
+  "Define a Common Lisp type NAME for UFFI type TYPE."
+  (declare (ignore type))
+  `(deftype ,name () t))
+
+(defmacro def-foreign-type (name type)
+  "Define a new foreign type."
+  `(cffi:defctype ,name ,(convert-uffi-type type)))
+
+(defmacro def-constant (name value &key export)
+  "Define a constant and conditionally export it."
+  `(eval-when (:compile-toplevel :load-toplevel :execute)
+     (defconstant ,name ,value)
+     ,@(when export `((export ',name)))
+     ',name))
+
+(defmacro null-char-p (val)
+  "Return true if character is null."
+  `(zerop (char-code ,val)))
+
+(defmacro def-enum (enum-name args &key (separator-string "#"))
+  "Creates a constants for a C type enum list, symbols are
+created in the created in the current package. The symbol is the
+concatenation of the enum-name name, separator-string, and
+field-name"
+  (let ((counter 0)
+        (cmds nil)
+        (constants nil))
+    (declare (fixnum counter))
+    (dolist (arg args)
+      (let ((name (if (listp arg) (car arg) arg))
+            (value (if (listp arg) 
+                       (prog1
+                           (setq counter (cadr arg))
+                         (incf counter))
+                       (prog1 
+                           counter
+                         (incf counter)))))
+        (setq name (intern (concatenate 'string
+                                        (symbol-name enum-name)
+                                        separator-string
+                                        (symbol-name name))))
+        (push `(def-constant ,name ,value) constants)))
+    (setf cmds (append '(progn) `((cffi:defctype ,enum-name :int))
+                       (nreverse constants)))
+    cmds))
+
+(defmacro def-struct (name &body fields)
+  "Define a C structure."
+  `(cffi:defcstruct ,name
+     ,@(loop for (name uffi-type) in fields
+             for cffi-type = (convert-uffi-type uffi-type)
+             collect (list name cffi-type))))
+
+;; TODO: figure out why the compiler macro is kicking in before
+;; the setf expander.
+(defun %foreign-slot-value (obj type field)
+  (cffi:foreign-slot-value obj type field))
+
+(defun (setf %foreign-slot-value) (value obj type field)
+  (setf (cffi:foreign-slot-value obj type field) value))
+             
+(defmacro get-slot-value (obj type field)
+  "Access a slot value from a structure."
+  `(%foreign-slot-value ,obj ,type ,field))
+
+;; UFFI uses a different function when accessing a slot whose
+;; type is a pointer. We don't need that in CFFI so we use
+;; foreign-slot-value too.
+(defmacro get-slot-pointer (obj type field)
+  "Access a pointer slot value from a structure."
+  `(cffi:foreign-slot-value ,obj ,type ,field))
+
+(defmacro def-array-pointer (name type)
+  "Define a foreign array type."
+  `(cffi:defctype ,name (uffi-array ,(convert-uffi-type type))))
+
+(defmacro deref-array (array type position)
+  "Dereference an array."
+  `(cffi:mem-aref ,array
+                  ,(if (constantp type)
+                       `',(element-type (cffi::parse-type
+                                         (convert-uffi-type (eval type))))
+                       `(element-type (cffi::parse-type
+                                       (convert-uffi-type ,type)))) 
+                  ,position))
+
+;; UFFI's documentation on DEF-UNION is a bit scarce, I'm not sure
+;; if DEFCUNION and DEF-UNION are strictly compatible.
+(defmacro def-union (name &body fields)
+  "Define a foreign union type."
+  `(cffi:defcunion ,name
+     ,@(loop for (name uffi-type) in fields
+             for cffi-type = (convert-uffi-type uffi-type)
+             collect (list name cffi-type))))
+
+(defmacro allocate-foreign-object (type &optional (size 1))
+  "Allocate one or more instance of a foreign type."
+  `(cffi:foreign-alloc ,(if (constantp type)
+                            `',(convert-uffi-type (eval type))
+                            `(convert-uffi-type ,type))
+                       :count ,size))
+
+(defmacro free-foreign-object (ptr)
+  "Free a foreign object allocated by ALLOCATE-FOREIGN-OBJECT."
+  `(cffi:foreign-free ,ptr))
+
+(defmacro with-foreign-object ((var type) &body body)
+  "Wrap the allocation of a foreign object around BODY."
+  `(cffi:with-foreign-object (,var (convert-uffi-type ,type))
+     , at body))
+
+;; Taken from UFFI's src/objects.lisp
+(defmacro with-foreign-objects (bindings &rest body)
+  (if bindings
+      `(with-foreign-object ,(car bindings)
+         (with-foreign-objects ,(cdr bindings)
+           , at body))
+      `(progn , at body)))
+
+(defmacro size-of-foreign-type (type)
+  "Return the size in bytes of a foreign type."
+  `(cffi:foreign-type-size (convert-uffi-type ,type)))
+
+(defmacro pointer-address (ptr)
+  "Return the address of a pointer."
+  `(cffi:pointer-address ,ptr))
+
+;; Hmm, we need to translate chars, so translations are necessary here.
+(defun %deref-pointer (ptr type)
+  (cffi::translate-type-from-foreign (cffi:mem-ref ptr type) (cffi::parse-type type)))
+
+(defun (setf %deref-pointer) (value ptr type)
+  (setf (cffi:mem-ref ptr type)
+        (cffi::translate-type-to-foreign value (cffi::parse-type type))))
+
+(defmacro deref-pointer (ptr type)
+  "Dereference a pointer."
+  `(%deref-pointer ,ptr (convert-uffi-type ,type)))
+
+(defmacro ensure-char-character (obj &environment env)
+  "Convert OBJ to a character if it is an integer."
+  (if (constantp obj env)
+      (if (characterp obj) obj (code-char obj))
+      (let ((obj-var (gensym)))
+        `(let ((,obj-var ,obj))
+           (if (characterp ,obj-var)
+               ,obj-var
+               (code-char ,obj-var))))))
+
+(defmacro ensure-char-integer (obj &environment env)
+  "Convert OBJ to an integer if it is a character."
+  (if (constantp obj env)
+      (let ((the-obj (eval obj)))
+        (if (characterp the-obj) (char-code the-obj) the-obj))
+      (let ((obj-var (gensym)))
+        `(let ((,obj-var ,obj))
+           (if (characterp ,obj-var)
+               (char-code ,obj-var)
+               ,obj-var)))))
+
+(defmacro ensure-char-storable (obj)
+  "Ensure OBJ is storable as a character."
+  `(ensure-char-integer ,obj))
+
+(defmacro make-null-pointer (type)
+  "Create a NULL pointer."
+  (declare (ignore type))
+  `(cffi:null-pointer))
+
+(defmacro make-pointer (address type)
+  "Create a pointer to ADDRESS."
+  (declare (ignore type))
+  `(cffi:make-pointer ,address))
+
+(defmacro null-pointer-p (ptr)
+  "Return true if PTR is a null pointer."
+  `(cffi:null-pointer-p ,ptr))
+
+(defparameter +null-cstring-pointer+ (cffi:null-pointer)
+  "A constant NULL string pointer.")
+
+(defmacro char-array-to-pointer (obj)
+  obj)
+
+(defmacro with-cast-pointer ((var ptr type) &body body)
+  "Cast a pointer, does nothing in CFFI."
+  (declare (ignore type))
+  `(let ((,var ,ptr))
+     , at body))
+
+(defmacro def-foreign-var (name type module)
+  "Define a symbol macro to access a foreign variable."
+  (declare (ignore module))
+  (flet ((lisp-name (name)
+           (intern (cffi-sys:canonicalize-symbol-name-case
+                    (substitute #\- #\_ name)))))
+    `(cffi:defcvar ,(if (listp name)
+                        name
+                        (list name (lisp-name name)))
+         ,(convert-uffi-type type))))
+
+(defmacro convert-from-cstring (s)
+  "Convert a cstring to a Lisp string."
+  (let ((ret (gensym)))
+    `(let ((,ret (cffi:foreign-string-to-lisp ,s)))
+       (if (equal ,ret "")
+           nil
+           ,ret))))
+
+(defmacro convert-to-cstring (obj)
+  "Convert a Lisp string to a cstring."
+  (let ((str (gensym)))
+    `(let ((,str ,obj))
+       (if (null ,str)
+           (cffi:null-pointer)
+           (cffi:foreign-string-alloc ,str)))))
+
+(defmacro free-cstring (ptr)
+  "Free a cstring."
+  `(cffi:foreign-string-free ,ptr))
+
+(defmacro with-cstring ((foreign-string lisp-string) &body body)
+  "Binds a newly creating string."
+  (let ((str (gensym)))
+    `(let ((,str ,lisp-string))
+       (if (null ,str)
+           (let ((,foreign-string (cffi:null-pointer)))
+             , at body)
+           (cffi:with-foreign-string (,foreign-string ,str)
+             , at body)))))
+
+;; Taken from UFFI's src/strings.lisp
+(defmacro with-cstrings (bindings &rest body)
+  (if bindings
+      `(with-cstring ,(car bindings)
+         (with-cstrings ,(cdr bindings)
+           , at body))
+      `(progn , at body)))
+
+(defmacro def-function (name args &key module (returning :void))
+  "Define a foreign function."
+  (declare (ignore module))
+  `(cffi:defcfun ,name ,(convert-uffi-type returning)
+     ,@(loop for (name type) in args
+             collect `(,name ,(convert-uffi-type type)))))
+
+;;; Taken from UFFI's src/libraries.lisp
+
+(defvar *loaded-libraries* nil
+  "List of foreign libraries loaded. Used to prevent reloading a library")
+
+(defun default-foreign-library-type ()
+  "Returns string naming default library type for platform"
+  #+(or win32 mswindows) "dll"
+  #+(or macos macosx darwin ccl-5.0) "dylib"
+  #-(or win32 mswindows macos macosx darwin ccl-5.0) "so")
+
+(defun foreign-library-types ()
+  "Returns list of string naming possible library types for platform,
+sorted by preference"
+  #+(or win32 mswindows) '("dll" "lib")
+  #+(or macos macosx darwin ccl-5.0) '("dylib" "bundle")
+  #-(or win32 mswindows macos macosx darwin ccl-5.0) '("so" "a" "o"))
+
+(defun find-foreign-library (names directories &key types drive-letters)  
+  "Looks for a foreign library. directories can be a single
+string or a list of strings of candidate directories. Use default
+library type if type is not specified."
+  (unless types
+    (setq types (foreign-library-types)))
+  (unless (listp types)
+    (setq types (list types)))
+  (unless (listp names)
+    (setq names (list names)))
+  (unless (listp directories)
+    (setq directories (list directories)))
+  #+(or win32 mswindows)
+  (unless (listp drive-letters)
+    (setq drive-letters (list drive-letters)))
+  #-(or win32 mswindows)
+  (setq drive-letters '(nil))
+  (dolist (drive-letter drive-letters)
+    (dolist (name names)
+      (dolist (dir directories)
+   (dolist (type types)
+     (let ((path (make-pathname 
+             #+lispworks :host
+             #+lispworks (when drive-letter drive-letter)
+             #-lispworks :device
+             #-lispworks (when drive-letter drive-letter)
+             :name name 
+             :type type
+             :directory 
+             (etypecase dir
+          (pathname
+           (pathname-directory dir))
+          (list
+           dir)
+          (string
+           (pathname-directory 
+            (parse-namestring dir)))))))
+       (when (probe-file path)
+         (return-from find-foreign-library path)))))))
+  nil)
+
+(defun convert-supporting-libraries-to-string (libs)
+  (let (lib-load-list)
+    (dolist (lib libs)
+      (push (format nil "-l~A" lib) lib-load-list))
+    (nreverse lib-load-list)))
+
+(defun load-foreign-library (filename &key module supporting-libraries
+                             force-load)
+  #+(or allegro mcl sbcl clisp) (declare (ignore module supporting-libraries))
+  #+(or cmu scl sbcl) (declare (ignore module))
+  
+  (when (and filename (probe-file filename))
+    (if (pathnamep filename) ;; ensure filename is a string to check if
+   (setq filename (namestring filename))) ; already loaded
+
+    (if (and (not force-load)
+        (find filename *loaded-libraries* :test #'string-equal))
+        t ;; return T, but don't reload library
+        (progn
+          #+cmu
+          (let ((type (pathname-type (parse-namestring filename))))
+            (if (string-equal type "so")
+                (sys::load-object-file filename)
+                (alien:load-foreign filename 
+                                    :libraries
+                                    (convert-supporting-libraries-to-string
+                                     supporting-libraries))))
+          #+scl
+          (let ((type (pathname-type (parse-namestring filename))))
+            (if (string-equal type "so")
+                (sys::load-dynamic-object filename)
+                (alien:load-foreign filename 
+                                    :libraries
+                                    (convert-supporting-libraries-to-string
+                                     supporting-libraries))))
+
+          #-cmu
+          (cffi:load-foreign-library filename)
+          
+          (push filename *loaded-libraries*)
+          t))))
+
+;; Taken from UFFI's src/os.lisp
+(defun getenv (var)
+  "Return the value of the environment variable."
+  #+allegro (sys::getenv (string var))
+  #+clisp (sys::getenv (string var))
+  #+(or cmu scl) (cdr (assoc (string var) ext:*environment-list* :test #'equalp
+                             :key #'string))
+  #+gcl (si:getenv (string var))
+  #+lispworks (lw:environment-variable (string var))
+  #+lucid (lcl:environment-variable (string var))
+  #+mcl (ccl::getenv var)
+  #+sbcl (sb-ext:posix-getenv var)
+  #-(or allegro clisp cmu scl gcl lispworks lucid mcl sbcl)
+  (error 'not-implemented :proc (list 'getenv var)))
+
+;; Taken from UFFI's src/os.lisp
+;; modified from function ASDF -- Copyright Dan Barlow and Contributors
+(defun run-shell-command (control-string  &rest args &key output)
+  "Interpolate ARGS into CONTROL-STRING as if by FORMAT, and
+synchronously execute the result using a Bourne-compatible shell, with
+output to *trace-output*.  Returns the shell's exit code."
+  (unless output
+    (setq output *trace-output*))
+
+  (let ((command (apply #'format nil control-string args)))
+    #+sbcl
+    (sb-impl::process-exit-code
+     (sb-ext:run-program
+      "/bin/sh"
+      (list "-c" command)
+      :input nil :output output))
+
+    #+(or cmu scl)
+    (ext:process-exit-code
+     (ext:run-program
+      "/bin/sh"
+      (list "-c" command)
+      :input nil :output output))
+
+    #+allegro
+    (excl:run-shell-command command :input nil :output output)
+
+    #+lispworks
+    (system:call-system-showing-output
+     command
+     :shell-type "/bin/sh"
+     :output-stream output)
+
+    #+clisp             ;XXX not exactly *trace-output*, I know
+    (ext:run-shell-command  command :output :terminal :wait t)
+
+    #+openmcl
+    (nth-value 1
+           (ccl:external-process-status
+        (ccl:run-program "/bin/sh" (list "-c" command)
+                 :input nil :output output
+                 :wait t)))
+
+    #-(or openmcl clisp lispworks allegro scl cmu sbcl)
+    (error "RUN-SHELL-PROGRAM not implemented for this Lisp")
+    ))
+
+;;; Some undocumented UFFI operators...
+
+(defmacro convert-from-foreign-string (obj &key (length most-positive-fixnum)
+                                       (locale :default)
+                                       (null-terminated-p t))
+  (declare (ignore locale))
+  (let ((ret (gensym)))
+    `(let ((,ret (cffi:foreign-string-to-lisp ,obj ,length ,null-terminated-p)))
+       (if (equal ,ret "")
+           nil
+           ,ret))))
+
+;; What's the difference between this and convert-to-cstring?
+(defmacro convert-to-foreign-string (obj)
+  (let ((str (gensym)))
+    `(let ((,str ,obj))
+       (if (null ,str)
+           (cffi:null-pointer)
+           (cffi:foreign-string-alloc ,str)))))
+
+(defmacro allocate-foreign-string (size &key unsigned)
+  (declare (ignore unsigned))
+  `(cffi:foreign-alloc :char :count ,size))
+
+;; Ditto.
+(defmacro with-foreign-string ((foreign-string lisp-string) &body body)
+  (let ((str (gensym)))
+    `(let ((,str ,lisp-string))
+       (if (null ,str)
+           (let ((,foreign-string (cffi:null-pointer)))
+             , at body)
+           (cffi:with-foreign-string (,foreign-string ,str)
+             , at body)))))
+
+(defmacro with-foreign-strings (bindings &body body)
+  `(with-foreign-string ,(car bindings)
+    ,@(if (cdr bindings)
+          `((with-foreign-strings ,(cdr bindings) , at body))
+          body)))
+
+;; This function returns a form? Where is this used in user-code?
+(defun foreign-string-length (foreign-string)
+  (declare (ignore foreign-string))
+  (error "FOREIGN-STRING-LENGTH not implemented."))
+
+;; This should be optimized.
+(defun convert-from-foreign-usb8 (s len)
+  (let ((a (make-array len :element-type '(unsigned-byte 8))))
+    (dotimes (i len a)
+      (setf (aref a i) (cffi:mem-ref s :unsigned-char i)))))



From bknr at bknr.net  Sun Oct 22 16:41:02 2006
From: bknr at bknr.net (bknr at bknr.net)
Date: Sun, 22 Oct 2006 12:41:02 -0400 (EDT)
Subject: [bknr-cvs] r2024 - branches/xml-class-rework/thirdparty/iconv
Message-ID: <20061022164102.7979E743BD@common-lisp.net>

Author: hhubner
Date: 2006-10-22 12:40:58 -0400 (Sun, 22 Oct 2006)
New Revision: 2024

Modified:
   branches/xml-class-rework/thirdparty/iconv/iconv.asd
   branches/xml-class-rework/thirdparty/iconv/iconv.lisp
Log:
converted to use cffi-uffi-compat


Modified: branches/xml-class-rework/thirdparty/iconv/iconv.asd
===================================================================
--- branches/xml-class-rework/thirdparty/iconv/iconv.asd	2006-10-22 15:57:04 UTC (rev 2023)
+++ branches/xml-class-rework/thirdparty/iconv/iconv.asd	2006-10-22 16:40:58 UTC (rev 2024)
@@ -4,4 +4,4 @@
   :author "Yoshinori Tahara "
   :version "0.2"
   :components ((:file "iconv"))
-  :depends-on (uffi))
+  :depends-on (cffi-uffi-compat))

Modified: branches/xml-class-rework/thirdparty/iconv/iconv.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/iconv/iconv.lisp	2006-10-22 15:57:04 UTC (rev 2023)
+++ branches/xml-class-rework/thirdparty/iconv/iconv.lisp	2006-10-22 16:40:58 UTC (rev 2024)
@@ -1,16 +1,19 @@
 (defpackage :koto.iconv
   (:nicknames :iconv)
-  (:use :cl :uffi)
+  (:use :cl :cffi-uffi-compat)
   (:export
    :iconv
    :EILSEQ
    :EINVAL
    :E2BIG))
-   
+
 (in-package :iconv)
 
+(cffi-uffi-compat:load-foreign-library "/usr/lib/libc.so")
+(cffi-uffi-compat:load-foreign-library "/usr/local/lib/libiconv.so")
+   
 #-:sbcl
-(uffi:def-foreign-var ("errno" errno) :int "iconv")
+(cffi-uffi-compat:def-foreign-var ("errno" errno) :int "iconv")
 
 (defun get-errno ()
   #-:sbcl
@@ -19,71 +22,58 @@
   (sb-alien:get-errno)
   )
 
-(uffi:def-constant EILSEQ #+freebsd 86 #-freebsd 84)           ;invalid multibyte
-(uffi:def-constant EINVAL 22)           ;imcomplete multibyte
-(uffi:def-constant E2BIG 7)             ;not enough outbuf
+(cffi-uffi-compat:def-constant EILSEQ #+freebsd 86 #-freebsd 84)           ;invalid multibyte
+(cffi-uffi-compat:def-constant EINVAL 22)           ;imcomplete multibyte
+(cffi-uffi-compat:def-constant E2BIG 7)             ;not enough outbuf
 
-(uffi:def-foreign-type char-ptr (* :unsigned-char))
-(uffi:def-foreign-type iconv-t :pointer-void)
+(cffi-uffi-compat:def-foreign-type uchar-ptr (* :unsigned-char))
+(cffi-uffi-compat:def-foreign-type iconv-t :pointer-void)
 
-(uffi:def-function ("iconv_open" iconv-open)
+(cffi-uffi-compat:def-function ("iconv_open" iconv-open)
     ((tocode :cstring)
      (fromcode :cstring))
   :returning 'iconv-t)
 
-(uffi:def-function ("iconv_close" iconv-close)
+(cffi-uffi-compat:def-function ("iconv_close" iconv-close)
     ((cd 'iconv-t))
   :returning :int)
 
-(uffi:def-function ("iconv" %iconv)
+(cffi-uffi-compat:def-function ("iconv" %iconv)
     ((cd 'iconv-t)
-     (inbuf (* char-ptr))
+     (inbuf (* uchar-ptr))
      (inbytesleft (* :unsigned-long))
-     (outbuf (* char-ptr))
+     (outbuf (* uchar-ptr))
      (outbytesleft (* :unsigned-long)))
   :returning :unsigned-int)
 
 (defmacro with-iconv-cd ((cd from to) &body body)
-  `(uffi:with-cstrings ((fromcode ,from)
+  `(cffi-uffi-compat:with-cstrings ((fromcode ,from)
 			(tocode ,to))
     (let ((,cd (iconv-open tocode fromcode)))
       (unwind-protect
 	   (progn , at body)
 	(iconv-close ,cd)))))
 
-(defun iconv (from-code to-code from-vector
+(defun iconv (from-code to-code from-string
 	      &optional error-p (error-value #.(char-code #\?)))
   (with-iconv-cd (cd from-code to-code)
-    (let* ((from-len (length from-vector))
+    (let* ((from-len (length from-string))
 	   (to-len (* from-len 2))
-	   (remain (make-array 3
-			       :element-type '(unsigned-byte 8)
-			       :fill-pointer 0
-			       :adjustable t))
-	   (string-mode (characterp (aref from-vector 0)))
-	   inbuffer
-	   (outbuffer (uffi:allocate-foreign-string to-len :unsigned t))
-	   (in-ptr (uffi:allocate-foreign-object 'char-ptr))
-	   (out-ptr (uffi:allocate-foreign-object 'char-ptr))
-	   (inbytesleft (uffi:allocate-foreign-object :unsigned-int))
-	   (outbytesleft (uffi:allocate-foreign-object :unsigned-int)))
+	   (inbuffer (cffi-uffi-compat:convert-to-foreign-string from-string))
+	   (outbuffer (cffi-uffi-compat:allocate-foreign-string to-len :unsigned t))
+	   (in-ptr (cffi-uffi-compat:allocate-foreign-object 'uchar-ptr))
+	   (out-ptr (cffi-uffi-compat:allocate-foreign-object 'uchar-ptr))
+	   (inbytesleft (cffi-uffi-compat:allocate-foreign-object :unsigned-int))
+	   (outbytesleft (cffi-uffi-compat:allocate-foreign-object :unsigned-int)))
       (unwind-protect
 	   (progn
-	     (if string-mode
-		 (setf inbuffer (uffi:convert-to-foreign-string from-vector))
-		 (progn
-		   (setf inbuffer (uffi:allocate-foreign-string from-len :unsigned t))
-		   (loop for i from 0 below from-len
-		      do (setf (uffi:deref-array inbuffer :unsigned-char i)
-			       (aref from-vector i)))))
-	     (setf (uffi:deref-pointer in-ptr 'char-ptr) inbuffer
-		   (uffi:deref-pointer out-ptr 'char-ptr) outbuffer
-		   (uffi:deref-pointer inbytesleft :unsigned-int) from-len
-		   (uffi:deref-pointer outbytesleft :unsigned-int) to-len)
+	     (setf (cffi-uffi-compat:deref-pointer in-ptr 'uchar-ptr) inbuffer
+		   (cffi-uffi-compat:deref-pointer out-ptr 'uchar-ptr) outbuffer
+		   (cffi-uffi-compat:deref-pointer inbytesleft :unsigned-int) from-len
+		   (cffi-uffi-compat:deref-pointer outbytesleft :unsigned-int) to-len)
 	     (labels
 		 ((current ()
-		    (- from-len (uffi:deref-pointer
-				 inbytesleft :unsigned-int)))
+		    (- from-len (cffi-uffi-compat:deref-pointer inbytesleft :unsigned-int)))
 		  (self ()
 		    (when (= (%iconv cd
 				     in-ptr inbytesleft
@@ -92,29 +82,17 @@
 		      (if (= (get-errno) EILSEQ)
 			  (if error-p
 			      (error "invalid multibyte(~X)."
-				     (uffi:deref-array
-				      inbuffer :unsigned-byte (current)))
+				     (cffi-uffi-compat:deref-array inbuffer (cffi-uffi-compat::convert-uffi-type :unsigned-byte) (current)))
 			      (progn
-				(setf (uffi:deref-array
-				       inbuffer :unsigned-byte (current))
-					  error-value)
+				(setf (cffi-uffi-compat:deref-array inbuffer (cffi-uffi-compat::convert-uffi-type :unsigned-byte) (current))
+				      error-value)
 				(self)))
-			  (loop for i from (current)
-			     below from-len
-			     do (vector-push-extend
-				 (aref from-vector i) remain))))))
+			  (error "unexpected iconv error ~A" (get-errno))))))
 	       (self))
-	     (let* ((out-length (- to-len (uffi:deref-pointer outbytesleft :unsigned-int)))
-		    (out (make-array out-length
-			    :element-type (array-element-type from-vector))))
-	       (dotimes (i out-length)
-		 (setf (aref out i) (if string-mode
-					(code-char (uffi:deref-array outbuffer :unsigned-byte i))
-					(uffi:deref-array outbuffer :unsigned-byte i))))
-	       (values out remain)))
-	(progn (uffi:free-foreign-object outbytesleft)
-	       (uffi:free-foreign-object inbytesleft)
-	       (uffi:free-foreign-object out-ptr)
-	       (uffi:free-foreign-object in-ptr)
-	       (uffi:free-foreign-object outbuffer)
-	       (uffi:free-foreign-object inbuffer))))))
+	     (cffi-uffi-compat:convert-from-foreign-string outbuffer :length (- to-len (cffi-uffi-compat:deref-pointer outbytesleft :unsigned-int))))
+	(cffi-uffi-compat:free-foreign-object outbytesleft)
+	(cffi-uffi-compat:free-foreign-object inbytesleft)
+	(cffi-uffi-compat:free-foreign-object out-ptr)
+	(cffi-uffi-compat:free-foreign-object in-ptr)
+	(cffi-uffi-compat:free-foreign-object outbuffer)
+	(cffi-uffi-compat:free-foreign-object inbuffer)))))



From bknr at bknr.net  Sun Oct 22 16:42:43 2006
From: bknr at bknr.net (bknr at bknr.net)
Date: Sun, 22 Oct 2006 12:42:43 -0400 (EDT)
Subject: [bknr-cvs] r2025 - in branches/xml-class-rework/thirdparty/uffi: .
	benchmarks doc examples src src/corman tests
Message-ID: <20061022164243.8775A751A1@common-lisp.net>

Author: hhubner
Date: 2006-10-22 12:42:37 -0400 (Sun, 22 Oct 2006)
New Revision: 2025

Added:
   branches/xml-class-rework/thirdparty/uffi/doc/catalog-darwin.xml
   branches/xml-class-rework/thirdparty/uffi/doc/catalog-mandrake.xml
   branches/xml-class-rework/thirdparty/uffi/doc/catalog-suse90.xml
   branches/xml-class-rework/thirdparty/uffi/doc/catalog-suse91.xml
   branches/xml-class-rework/thirdparty/uffi/doc/catalog-ubuntu.xml
   branches/xml-class-rework/thirdparty/uffi/tests/objects.lisp
Removed:
   branches/xml-class-rework/thirdparty/uffi/doc/html.tar.gz
Modified:
   branches/xml-class-rework/thirdparty/uffi/ChangeLog
   branches/xml-class-rework/thirdparty/uffi/Makefile
   branches/xml-class-rework/thirdparty/uffi/NEWS
   branches/xml-class-rework/thirdparty/uffi/README
   branches/xml-class-rework/thirdparty/uffi/TODO
   branches/xml-class-rework/thirdparty/uffi/benchmarks/allocation.lisp
   branches/xml-class-rework/thirdparty/uffi/doc/Makefile
   branches/xml-class-rework/thirdparty/uffi/doc/bookinfo.xml
   branches/xml-class-rework/thirdparty/uffi/doc/catalog-suse.xml
   branches/xml-class-rework/thirdparty/uffi/doc/ref_aggregate.xml
   branches/xml-class-rework/thirdparty/uffi/doc/ref_declare.xml
   branches/xml-class-rework/thirdparty/uffi/doc/ref_func_libr.xml
   branches/xml-class-rework/thirdparty/uffi/doc/ref_object.xml
   branches/xml-class-rework/thirdparty/uffi/doc/ref_string.xml
   branches/xml-class-rework/thirdparty/uffi/doc/uffi.pdf
   branches/xml-class-rework/thirdparty/uffi/examples/Makefile
   branches/xml-class-rework/thirdparty/uffi/examples/Makefile.msvc
   branches/xml-class-rework/thirdparty/uffi/examples/acl-compat-tester.lisp
   branches/xml-class-rework/thirdparty/uffi/examples/arrays.lisp
   branches/xml-class-rework/thirdparty/uffi/examples/atoifl.lisp
   branches/xml-class-rework/thirdparty/uffi/examples/c-test-fns.c
   branches/xml-class-rework/thirdparty/uffi/examples/c-test-fns.lisp
   branches/xml-class-rework/thirdparty/uffi/examples/compress.lisp
   branches/xml-class-rework/thirdparty/uffi/examples/file-socket.lisp
   branches/xml-class-rework/thirdparty/uffi/examples/getenv.lisp
   branches/xml-class-rework/thirdparty/uffi/examples/gethostname.lisp
   branches/xml-class-rework/thirdparty/uffi/examples/getshells.lisp
   branches/xml-class-rework/thirdparty/uffi/examples/gettime.lisp
   branches/xml-class-rework/thirdparty/uffi/examples/run-examples.lisp
   branches/xml-class-rework/thirdparty/uffi/examples/strtol.lisp
   branches/xml-class-rework/thirdparty/uffi/examples/test-examples.lisp
   branches/xml-class-rework/thirdparty/uffi/examples/union.lisp
   branches/xml-class-rework/thirdparty/uffi/src/aggregates.lisp
   branches/xml-class-rework/thirdparty/uffi/src/corman/getenv-ccl.lisp
   branches/xml-class-rework/thirdparty/uffi/src/functions.lisp
   branches/xml-class-rework/thirdparty/uffi/src/libraries.lisp
   branches/xml-class-rework/thirdparty/uffi/src/objects.lisp
   branches/xml-class-rework/thirdparty/uffi/src/os.lisp
   branches/xml-class-rework/thirdparty/uffi/src/package.lisp
   branches/xml-class-rework/thirdparty/uffi/src/primitives.lisp
   branches/xml-class-rework/thirdparty/uffi/src/readmacros-mcl.lisp
   branches/xml-class-rework/thirdparty/uffi/src/strings.lisp
   branches/xml-class-rework/thirdparty/uffi/tests/Makefile
   branches/xml-class-rework/thirdparty/uffi/tests/Makefile.msvc
   branches/xml-class-rework/thirdparty/uffi/tests/arrays.lisp
   branches/xml-class-rework/thirdparty/uffi/tests/atoifl.lisp
   branches/xml-class-rework/thirdparty/uffi/tests/casts.lisp
   branches/xml-class-rework/thirdparty/uffi/tests/compress.lisp
   branches/xml-class-rework/thirdparty/uffi/tests/foreign-loader.lisp
   branches/xml-class-rework/thirdparty/uffi/tests/foreign-var.lisp
   branches/xml-class-rework/thirdparty/uffi/tests/getenv.lisp
   branches/xml-class-rework/thirdparty/uffi/tests/gethostname.lisp
   branches/xml-class-rework/thirdparty/uffi/tests/make.sh
   branches/xml-class-rework/thirdparty/uffi/tests/package.lisp
   branches/xml-class-rework/thirdparty/uffi/tests/strtol.lisp
   branches/xml-class-rework/thirdparty/uffi/tests/structs.lisp
   branches/xml-class-rework/thirdparty/uffi/tests/time.lisp
   branches/xml-class-rework/thirdparty/uffi/tests/uffi-c-test-lib.lisp
   branches/xml-class-rework/thirdparty/uffi/tests/uffi-c-test.c
   branches/xml-class-rework/thirdparty/uffi/tests/union.lisp
   branches/xml-class-rework/thirdparty/uffi/uffi-tests.asd
   branches/xml-class-rework/thirdparty/uffi/uffi.asd
Log:
current uffi release, does not fix memory leakage with pointers to
pointers on freebsd.  it seems that cffi is the way to go.


Modified: branches/xml-class-rework/thirdparty/uffi/ChangeLog
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/ChangeLog	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/ChangeLog	2006-10-22 16:42:37 UTC (rev 2025)
@@ -1,3 +1,116 @@
+2006-10-10 Kevin Rosenberg (kevin at rosenberg.net)
+	* Version 1.5.17
+	* src/functions.lisp: Patch from Edi Weitz for Lispworks 5/Linux
+	
+2006-09-02 Kevin Rosenberg (kevin at rosenberg.net)
+	* Version 1.5.16
+	* src/libraries.lisp: Add cygwin support
+	
+2006-08-13 Kevin Rosenberg (kevin at rosenberg.net)
+	* Version 1.5.15
+	* src/{objects,strings}.lisp: Add support for Lispworks 5 
+	thanks to patches from Bill Atkins 
+
+2006-07-04 Kevin Rosenberg (kevin at rosenberg.net)
+	* Version 1.5.14
+	* src/{objects,strings}.lisp: Apply patch from Edi Weitz
+
+2006-05-17 Kevin Rosenberg (kevin at rosenberg.net)
+	* Version 1.5.13 
+	* src/libraries.lisp: Revert buggy patch from Yaroslav Kavenchuk.
+
+2006-05-17 Kevin Rosenberg (kevin at rosenberg.net)
+	* Version 1.5.12 
+	* src/libraries.lisp: Patch from Yaroslav Kavenchuk to set
+	default drive letters on MS Windows.
+
+2006-05-11 Kevin Rosenberg (kevin at rosenberg.net)
+	* Version 1.5.11: Export new macro DEF-POINTER-VAR based on patch from
+	James Bielman to support defining variables on platforms which
+	support saving objects, such as openmcl
+
+2006-04-17 Kevin Rosenberg (kevin at rosenberg.net)
+	* Version 1.5.10: Commit patch from Gary King for openmcl's
+	feature list change
+
+2005-11-14 Kevin Rosenberg (kevin at rosenberg.net)
+	* Version 1.5.7
+	* src/strings.lisp: Add with-foreign-strings by James Biel
+	
+2005-11-14 Kevin Rosenberg (kevin at rosenberg.net)
+	* Version 1.5.6
+	* src/os.lisp: Remove getenv setter
+
+2005-11-07 Kevin Rosenberg (kevin at rosenberg.net)
+	* Version 1.5.5
+	* src/os.lisp: Add support for getenv getter and setter
+	
+2005-09-17 Kevin Rosenberg (kevin at rosenberg.net)
+	* Version 1.5.4
+	* src/objects.lisp: prepend _ character for entry
+	point on Allegro macosx, patch by Luis Oliveira
+	
+2005-07-05 Kevin Rosenberg (kevin at rosenberg.net)
+	* Version 1.5.0
+	* Remove vestigial LLGPL license notices as UFFI as been
+	BSD-licensed for several years.
+	
+2005-06-09 Kevin Rosenberg (kevin at rosenberg.net)
+	* Version 1.4.39
+	* tests/objects.lisp: Rename from pointers.lisp. 
+	Fix test CHPTR.4 as noted by Jorg Hohle
+	* src/objects.lisp: Remove default from ensure-char-integer
+	
+2005-06-09 Kevin Rosenberg (kevin at rosenberg.net)
+	* Version 1.4.38
+	* src/libraries.lisp: Commit patch from Edi Weitz to
+	allow plain filename library names to allow underlying
+	lisp implementation to find foreign libraries in the
+	locations known to the operating system.
+	* tests/cast.lisp: Add :module keyword as noted by Jorg Hohle.
+	* src/strings.lisp: Avoid multiple evaluation of input
+	parameters for macros as noted by Jorg Hohle.
+	
+2005-04-12 Kevin Rosenberg (kevin at rosenberg.net)
+	* Version 1.4.37
+	* src/strings.lisp: Fix variable name
+	
+2005-04-04 Kevin Rosenberg (kevin at rosenberg.net)
+	* src/strings.lisp, src/aggregates.lisp: Support change in SBCL copy
+	function [Thanks for Nathan Froyd and Zach Beane]
+	
+2005-04-03 Kevin Rosenberg (kevin at rosenberg.net)
+	* src/objects.lisp: Commit patch from James Bielman to add
+	def-foreign-var support for OpenMCL
+	
+2005-03-03 Kevin Rosenberg (kevin at rosenberg.net)
+	* src/primitives.lisp: Add support for :union types
+	[patch from Cyrus Harmon]
+	* tests/union.lisp, tests/structs.lisp: Tests for
+	union and structure types [from Cyrus Harmon]
+	
+2005-02-22 Kevin Rosenberg (kevin at rosenberg.net)
+	* src/primitives.lisp, src/strings.lisp: Better support 
+	for sb-unicode [from Yoshinori Tahara and R. Mattes]
+
+2005-01-22 Kevin Rosenberg (kevin at rosenberg.net)
+	* src/primitives.lisp: Better support SBCL-AMD64
+	
+2004-11-08 Kevin Rosenberg (kevin at rosenberg.net)
+	* src/strings.lisp: Better support sb-unicode
+	* tests/compress.lisp: Support sb-unicode
+	
+2004-10-07 Kevin Rosenberg (kevin at rosenberg.net)
+	* src/objects.lisp: Add new function:
+	convert-from-foreign-usb8
+	
+2004-04-15 Kevin Rosenberg (kevin at rosenberg.net)
+	* src/objects.lisp: Add new functions:
+	MAKE-POINTER and POINTER-ADDRESS
+
+2004-04-13 Kevin Rosenberg (kevin at rosenberg.net)
+	* src/string.lisp: Add new FOREIGN-STRING-LENGTH
+
 2003-08-15 Kevin Rosenberg (kevin at rosenberg.net)
 	* Added with-cast-pointer and def-foreign-var (patches submitted
 	by Edi Weitz). 

Modified: branches/xml-class-rework/thirdparty/uffi/Makefile
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/Makefile	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/Makefile	2006-10-22 16:42:37 UTC (rev 2025)
@@ -5,13 +5,9 @@
 #  Programer:    Kevin M. Rosenberg, M.D.
 #  Date Started: Mar 2002
 #
-#  CVS Id:   $Id: Makefile,v 1.1 2004/06/23 08:27:10 hans Exp $
+#  CVS Id:   $Id$
 #
-# This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
-#
-# UFFI users are granted the rights to distribute and use this software
-# as governed by the terms of the Lisp Lesser GNU Public License
-# (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+# This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 
 PKG:=uffi
 DEBPKG=cl-uffi

Modified: branches/xml-class-rework/thirdparty/uffi/NEWS
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/NEWS	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/NEWS	2006-10-22 16:42:37 UTC (rev 2025)
@@ -1,3 +1 @@
-UFFI now passes all tests with SCL, SBCL, & OpenMCL in Debian.
-
-UFFI now uses ASDF system definition files.
+UFFI now supports AllegroCL AMD64

Modified: branches/xml-class-rework/thirdparty/uffi/README
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/README	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/README	2006-10-22 16:42:37 UTC (rev 2025)
@@ -1,5 +1,5 @@
 Package:  UFFI (Universal Foreign Language Interface)
-Web site: http://uffi.med-info.com
+Web site: http://uffi.b9.com
 Author:   Kevin M. Rosenberg
 
 
@@ -14,7 +14,7 @@
 uffi features into the specific syntax of supported Common Lisp
 implementations.
 
-Currently, AllegroCL v6.1 (Linux and Microsoft Windows), Lispworks
-v4.2 (Linux and Microsoft Windows), and CMUCL are supported.
+Currently, AllegroCL (Linux and Microsoft Windows), Lispworks (Linux
+and Microsoft Windows), CMUCL, SBCL, and OpenMCL are supported.
 
 

Modified: branches/xml-class-rework/thirdparty/uffi/TODO
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/TODO	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/TODO	2006-10-22 16:42:37 UTC (rev 2025)
@@ -1,5 +1,7 @@
 - Run test-suite on MCL port
 
+- Add OpenMCL support for with-cast-pointer and def-foreign-var
+
 - Add support for direct vector passing to and from foreign functions
    to avoid copying elements in and out of vector.
-b
+

Modified: branches/xml-class-rework/thirdparty/uffi/benchmarks/allocation.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/benchmarks/allocation.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/benchmarks/allocation.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,13 +7,10 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Mar 2002
 ;;;;
-;;;; $Id: allocation.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))

Modified: branches/xml-class-rework/thirdparty/uffi/doc/Makefile
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/doc/Makefile	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/doc/Makefile	2006-10-22 16:42:37 UTC (rev 2025)
@@ -6,13 +6,9 @@
 #  Programer:    Kevin M. Rosenberg
 #  Date Started: Mar 2002
 #
-#  CVS Id:   $Id: Makefile,v 1.1 2004/06/23 08:27:10 hans Exp $
+#  CVS Id:   $Id$
 #
-# This file, part of UFFI, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
-#
-# UFFI users are granted the rights to distribute and use this software
-# as governed by the terms of the Lisp Lesser GNU Public License
-# (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+# This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ##############################################################################
 
 DOCFILE_BASE_DEFAULT:=uffi
@@ -21,24 +17,42 @@
 
 # Standard docfile processing
 
-DEBIAN=$(shell expr "`cat /etc/issue`" : '.*Debian.*')
-SUSE=$(shell expr "`cat /etc/issue`" : '.*SuSE.*')
-REDHAT=$(shell expr "`cat /etc/issue`" : '.*RedHat.*')
+DEBIAN=$(shell expr "`cat /etc/issue 2> /dev/null`" : '.*Debian.*')
+UBUNTU=$(shell expr "`cat /etc/issue 2> /dev/null`" : '.*Ubuntu.*')
+SUSE=$(shell expr "`cat /etc/issue 2> /dev/null`" : '.*SuSE.*')
+SUSE91=$(shell expr "`cat /etc/issue 2> /dev/null`" : '.*SuSE Linux 9.1.*')
+REDHAT=$(shell expr "`cat /etc/issue 2> /dev/null`" : '.*Red Hat.*')
+MANDRAKE=$(shell expr "`cat /etc/issue 2> /dev/null`" : '.*Mandrake.*')
+DARWIN=$(shell expr "`uname -a`" : '.*Darwin.*')
 
-
 ifneq (${DEBIAN},0)
 OS:=debian
 else
-  ifneq (${SUSE},0)
-    OS=suse
-  else   
-    ifneq (${REDHAT},0)
-      OS=redhat
+  ifneq (${SUSE91},0)
+    OS=suse91
+  else
+    ifneq (${SUSE},0)
+      OS=suse
+    else   
+      ifneq (${REDHAT},0)
+        OS=redhat
+      else   
+        ifneq (${MANDRAKE},0)
+          OS=mandrake
+        else   
+          ifneq (${DARWIN},0)
+            OS=darwin
+          else  
+            ifneq (${UBUNTU},0)
+              OS=ubuntu
+            endif 
+          endif 
+        endif
+      endif
     endif
   endif
 endif
 
-
 ifndef DOCFILE_BASE
 DOCFILE_BASE=${DOCFILE_BASE_DEFAULT}
 endif

Modified: branches/xml-class-rework/thirdparty/uffi/doc/bookinfo.xml
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/doc/bookinfo.xml	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/doc/bookinfo.xml	2006-10-22 16:42:37 UTC (rev 2025)
@@ -24,8 +24,8 @@
   
   
   
-    $Id: bookinfo.xml,v 1.1 2004/06/23 08:27:10 hans Exp $
-    File $Date: 2004/06/23 08:27:10 $
+    $Id$
+    File $Date$
   
   
     2002-2003

Added: branches/xml-class-rework/thirdparty/uffi/doc/catalog-darwin.xml
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/doc/catalog-darwin.xml	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/doc/catalog-darwin.xml	2006-10-22 16:42:37 UTC (rev 2025)
@@ -0,0 +1,43 @@
+
+
+
+
+
+  
+  
+
+    
+    
+    
+    
+
+    
+    
+
+    
+    
+    
+    
+
+    
+    
+    
+    
+
+  
+
+

Added: branches/xml-class-rework/thirdparty/uffi/doc/catalog-mandrake.xml
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/doc/catalog-mandrake.xml	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/doc/catalog-mandrake.xml	2006-10-22 16:42:37 UTC (rev 2025)
@@ -0,0 +1,43 @@
+
+
+
+
+
+  
+  
+
+    
+    
+    
+    
+
+    
+    
+
+    
+    
+    
+    
+
+    
+    
+    
+    
+
+  
+
+

Modified: branches/xml-class-rework/thirdparty/uffi/doc/catalog-suse.xml
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/doc/catalog-suse.xml	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/doc/catalog-suse.xml	2006-10-22 16:42:37 UTC (rev 2025)
@@ -6,7 +6,7 @@
 
 
   
-  
+  
 
     
     
     
+        uri="docbook/stylesheet/nwalsh/current/xhtml/docbook.xsl" />
     
+        uri="docbook/stylesheet/nwalsh/current/xhtml/chunk.xsl" />
     
+        uri="docbook/stylesheet/nwalsh/current/fo/docbook.xsl" />
 
   
 

Added: branches/xml-class-rework/thirdparty/uffi/doc/catalog-suse90.xml
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/doc/catalog-suse90.xml	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/doc/catalog-suse90.xml	2006-10-22 16:42:37 UTC (rev 2025)
@@ -0,0 +1,43 @@
+
+
+
+
+
+  
+  
+
+    
+    
+    
+    
+
+    
+    
+
+    
+    
+    
+    
+
+    
+    
+    
+    
+
+  
+
+

Added: branches/xml-class-rework/thirdparty/uffi/doc/catalog-suse91.xml
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/doc/catalog-suse91.xml	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/doc/catalog-suse91.xml	2006-10-22 16:42:37 UTC (rev 2025)
@@ -0,0 +1,48 @@
+
+
+
+
+
+  
+  
+
+    
+    
+    
+    
+
+    
+    
+
+    
+    
+    
+    
+    
+    
+    
+    
+    
+    
+
+  
+
+

Added: branches/xml-class-rework/thirdparty/uffi/doc/catalog-ubuntu.xml
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/doc/catalog-ubuntu.xml	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/doc/catalog-ubuntu.xml	2006-10-22 16:42:37 UTC (rev 2025)
@@ -0,0 +1,43 @@
+
+
+
+
+
+  
+  
+
+    
+    
+    
+    
+
+    
+    
+
+    
+    
+    
+    
+
+    
+    
+    
+    
+
+  
+
+

Deleted: branches/xml-class-rework/thirdparty/uffi/doc/html.tar.gz
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/doc/html.tar.gz	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/doc/html.tar.gz	2006-10-22 16:42:37 UTC (rev 2025)
@@ -1,85 +0,0 @@
-?qZ???]?r?8??_?)p4u&??u?????????*?Z;;s~??H???"9?H?y?Sd?????????3JX???!?x??w??O?{???^E?,mD?cOG??0??}????n?MfM/?`?8c?U?? ?G?P??r????'?z?5	T`2z\|s??31E?yE?\?^??????({UQ#?jc?M@@`1">?8`8?~??M9?L?`J?,?0)?#??M?A?*?????e9TL???pX:x?????[Oj??u??	?Z?????`?5d:.??e????m???????
?[??qQ?????t?b????L??y&?-??c.??43?1?@?f???a?FB??]??Z?	l.?w???3d7??E7?????}s??s???u*?_?l??u??F?u??#?;?????f?O?3???Zb~??K??
-??P:????k{z?FyC??????.?Cz??J??CU(??? ??+??|$?6rb??`??m?4?wM?P????3-??"?	`??-??l?3DP????????\???I|?????k?b??w"~??J??3w?&b?_?y|\??\EB?m???7	+?J?r?????:^??v??gP??z????1?????0??]?x5????we?8?Y?
-MfJ@??I
??oJg??:7?f?F!????|?g???.?=?.?VW?????a??????????????$?w1?????l?g??:??#??\?/}??_?T??m??|???_??{??#?!??ud??k?p??_?U?GC??g?ml?l3??????V?]oH?>?$P???????`??13??n?
>??% ?$?Cz+eY?*?a?z?????5">?o??G?T?|??!?t???[?F?qCg?c????Ui??|??b??k???U?;?_O?????-/??2:6??:_W!??P?]K,???]s?????A??&??3???????L??{??=???3??????1?/Q??\o???"???,??l??II??
-?g?e??xTa?.????G????_??8????{BC?RTs??~OBN0?? 
?7??c%?????FP~??Th?-#93 3?
-+?5d??H>???nY?|q6?i????wY????"?G$C?j
-S????????p?D?T?PeIM?6!????0???B????]1???>??Q?.?iR!???????8[????`????&S{???l	?1am????
k^?c??>?:\????}?v?u??>???QL???:????	??L^?????:???p3j:VTn]?5M?s|]?~???vy??qu?C??????,???a:????^'
???W?2??n???`???6?9?2O"?7? ?x6?.??-?w*?"???vq?5M?K?Fl?xS??
"?|'?s??e.??$1y4???g??N???~?F"??D?X??eQ1???7dd`J??H-vBd
-?VR??r?1(?"*.d8??K?MS-??h-??(@?????|XN?a?I??7e?M?'?W??B?"?}?B???i[??o9$??;4oM?V:?D#??y???N??m?????kU6???{o???#???Kk????v3??Uo???????-\?~*???J?;=9???2????F?~ed$0PL*??'??????|??I?E????????p_????i?*?R????H?????kx\ID?U?B????!7??t???:v
-{????Yd??g??tQ2O??e:A???1?c?&?KM?Q!?;L??????m2?j0"??c?9"DG??@i???@?zr1a"?TEG0?R?O????k?w??e
-k??'e?|?????|J?G??O\???_????[???5??k?XX??a???????t+P{*?H[N?6r?*+u???Z??ph????E??????PqU?\]vU&?H???g-u?h???	?-???Xwr,???c{B1r???'?[F??H???T?6??J?U])??H?M?G???`D???Y????YW?6?B??Vo$\???c???2??`2?=IZ??=?9c^???/$??H,S?
?(??`?Y?rn?y??+*??|U??}?8?%Y?	??6?r?Yx?Kv???-?B?c?\8o??Wu?':]??P!??????'>
-G???J\?????h??9uz??^?,.K????????e?"{????b9;?e%4?-9???@?Y??Z[^fI??? ???>??h5K]??G????e??xE????9]e?;[?/!??G???????????>???????T?Z?M?WBoNA9IR??I?E
?bG?z?U?yS?Z??cs?\???W?????k?1?????l
-/i
?????u_??w?Wq?\?WX
?t?}??3???k?OG}???3z???;?/?????r?Xt|N??8?P?cU
-?,???;?P??{q?4P???^???v'???798?????O1????.??????????;?????@??;#??w?F?s???#/??F??????J?"n	?"g???i?>K??_?G?7'?G]mN???
?
??0;l6?,J??t?^??lG?W5m?\?s?"N??q?????>?sU?}t?????????u???#?"v?? ;ar?P;cd???????;??????????????????e?E?????Q?9??b?????*?}"P
-??0???	????:Z?\??J?/????? ????q?x?sy????4???y??h???M?Z^&??z???U??8?}?1)???Q??T?Mnw???g?[CK???n??\Y?O3Ct+??b???o8H?[?????]?M??g$?|??????????????gf?O??q??{l?w??e???????/??3??qIwVb???3??5?O9s???
?d?????0??????K??4?w?AF%??E??j?~?,?????[ ????2????E??d?,?rk?F?{Y0C|Vv[????G\????hZV??r?*?k???R1???(A??????A?3??.`	???Hk?b??CWr??c?*?>?? ?l??R??e$>s??????y???T?s?{?"?!????b).j??8??>B??Ha??.O2?]Lew?7hu?"[?78=yM at 9????u??
-v~RA?%y??	??>.=&?Kq?{???xw?M"?ZO??????????Y??'?=??W?Q??/?9?	?;?l"#???"???k?^2/?=?VJ?C[??/??d??O???-?r????c??+t?W?/???3?????h?	???	?}	???G???8G?ja[??r?~+????-,v??`g??G?9?:??q???tj???oN??0<:El??:z?????@??c?Y??M}?????????6G????s???Y@?????j~?G?????|r=,??}?u?lZ???O?????;6???R??]??/?N?J[?QB?V?_/v?8!I?D?|?#%Xl????N????L=?C?????/> Z?^'R?????Z?J????(_?Z2q<3???=??_yf*WKh	VA???%?e?y??:???2 ?*??r??{$_?kB{??)??
-o?w??]?D?ec???M?????b?B???S??Vx?OV\xw^???iE	?{_??????9?]v?DJD?;)e?u??q]?N???N??R 	I?_???L???????{No?	???Ca????<}5????>,?$??0U	????????N???U?@?K!gq??da?%{??HY?
&?????????]?VD??[\53??gG?gD6L???Di?????)???4c??H
-{?U??D???jZ???i?JJ??t?F?????3D???? .q?.?Mju????:Y<&l???NvR?9e????i???A????"]???L?q&u????Th????Vg??K??j$????v4D6????x???L???>d????i?Z?s!????{U?X?S?O?~?Ia6??t?#??Qq]#s?k*,?-?,???s?????st???i???f?=??????Uz??PP??i1z???G???z???t??aJ8???]?*??0??{L????.
-??r`?P"?Jd?K?l?G3zze?	>`'-"?O?'?Tk?2M??rl+4k???1???"?6;?acG???????}?7T??U[?p?6??????dZ?<.?j??0??V2?+?5???K?\N??????~???@A??[O-r?==?????????S*On[?	??G???D??8?Lm?Rh)e?i?K????H???? ??p???\??\fL??ia??=??#???_????R).f?.:????0_?Pg??9??
-?G?n???~g???R??>th$?B8?40??
??Z?????????}}?>?a?t??6Jy??;?A???N?????0??
- ?a~?)??a2?&h????| `??+424D)??h??H?M??xVkb ????d????QC4?@?{??????c?~?w?????(+????|M]???h????98??*L????c??7,wm3?8??7??E8??%??G+?>?>??9?X]?0B????hi?????Q??Gw?????s?????#"w?1l??K?????rL??I?%?73????rc?9jj??HL??#N?C???p???&?N?0??Hk?W;?????7|D?C?*Z?!?"????_?AV??*??{i????A??Cw??4????_??????Z?
- ?zf?$AoW????-???t?P???"?????9>???* ?
r???j?J???Q???`E???S?r(?@T???a?i???g/\?&?Y?cb>nv?}?t?
-???JMT???G???a?????,\??
-dG??qvD????????X??NQ?p?) $??????]r,??&????????Hac	???]??g7??@v?????7?X?.t??#?]-???^?9'?o????{?????o???'????~}????????{???????||?:~}????W??3?????W?:??RH??f0GT??????(?Q??q??d?F?G?&e????G?}-mh
>?%???+9?Og?????h???4?O?????????5????*?;v?b-??s=????XM??V?`t]?4'?????y???;U???bt1?????te???C????%?O??0??.???
-??[?O?'e?7V???z?<=m	nb??Hb??R?? AJ2???{C?..??{?[??)9?????)s4"????'k???2w?'???z6?*???i?3
?y?????????OW????q??(P?QgR?	????y?+?-?a%?]61F9?N?V>!?%?&2
-CM?H$n??2?Y=?SH?Pc
-L,B????O???6?r??>U7?rh??8f	2?y??????
-f???e??????-?)
m?N???r?na???????,+??4N?t???S0???CL(??$?YM??????#???????\?I.#??q???5????5RI??F?Q??z???????G???{??q???????3?Q!?3????/?d.??7?1a?	??????W?Z??????-??`'?7`??????7????9?:e??&?OvM?q?fw
-	;??5 ?4??	3`?8??????*?h???z??]P?x???S+???????)??1??1)#?wl????$}T,????:???#?????5?U?j0?g&?>7?	?E?t?Mkr?l?^^??0??3?w??6?Y??.??r7?Y??9???48,?????`1????tX?1#Pwc^?[c???@7??o??6L??????ztD?/;?????Qn?????r?0d?Z?CN??????????Kq.lA?88T????r?S?+????7??S4????????I??B??5???k??(???
-??}??	dw??? ?cB?0?sl?????3z^+$Q????????Z2?"54`9?
j??o????
J??Nz?Fh4xdi?e?????T?`??j#???X-???h9P??/.?%??a????r?%??9?2?.?$P??JE?F?c(??4?????????z???[ro?h?Y?&a???q??m???????????????o??|???0Gx????W??3?????W?:/R????v??4 ?^?Jr??>??m?U6#??,?B??????@u???????;?????N??4?O}???9???@???9 ~???*????@?tpQ!?5?19 3?wl.?\pB/?S??@[?6
Hs??????H??2?F?4?e?`???Q???????/"???_,?tQ??@??.??C??????}????`????r(????H;??x???O?p?A$?7????????B0?P^??6?????hV????,??Eh??
??0??>?4????0???ac~f?oIS}?F??'?_YP?&?E7~?=?dM
:?^IL??3???:??L?{mS? d????wv???>?????^??,:???^>???_??}j ??k????????v?
-?c~"????4?g????????y??????E?h?????9??Q{kI???^??????i???????eR?1?AK????????R?qM????????|J??b??,6HP}erA??I??zAAo-??t?v?y??7,PH???&???yq1??J???t(VDV??????t??G?9????Po\???I??)????3?4\NM??<?p:96I??*gv"?mx?G???{vY?_??????a??4?O}????u???w???*??ZOIV!?cj??T?d????${?\????H?????lk?jF????7o4?Y?c???$N>1jXU(?3?v??K???Ya?"??R???b)?jh1???Q.,x????tG?T??+???b?E?[??t?[????c????D]?:?? '?X??u???s	T???6H?+???~^????x??9
?
?o?}?d?|??/=???c?d???7??}?4@????N?`?-qL D??????G??(>`????B!suT@?? ??iw,?
-???D?\??"f??z?c???u6$p??n???A??t??W?y??6?N?:??O?i?????;???rr?O?35T????y??-??}????r???8?????n7,?{?\????E????}zI?$??3?W?a?x????`+?oAID????+!???Z`??e6V??b??f???X????r?????h?r?9????=??????`?? d???W????3?$s??,?/y???|??~???????v???u	&}?????+r??.a>??0KkC??S??&?W?=??|??B??O?????^????????%B?=??,?6??d??q?y]?E?????RD???n?%?'N??>??~???C?`=?\??2v+1/??'???PY?s??V!K?`?K
-?y1??(??|4????F????_?I^??&?????	??G?????^??}?????[N????'?|????K
-X??_??@??/Y???y?X,??vpI?qr?~?V?y?Y1
-?ZW??(?????l'????e??Z?#?b??%r?`(??P?? jsN???&@E????y???]?U?~??7?gO?????)?GK???zm{8)pV?P??n;+????e
-???????????
K???K??GqJh???1=(
-;??p!?V5LD??*4?8?3?b??Q?L6W1be_?????????Th???j?!?????0????F????j???L?y?????ioW?Q==z;?????C??zB1/UH	j??a?^5????????????i?	 ?$??0?K?????`&1]#??i??=?'t?N??X*R???s?E???*5????Y0?2V?E|W?g?3?J????I$z???B???y?????4??????^G}?!)????????G36??J'??M
bR??#???M
-?Pc??p?~??????eI??]m?E????'=V??E"??????p.??u??
??,?[??OTS(1??#S??=l??}?
-???1?gr??xR?s?h
-uKq????Y?H?I?L)??X?I??kk?r?W?_?f???x?t??$???qI?t!+U
???/:?????x(?P?M?Q0jF	E*?B??C??O???^_??u???t?
??0??|E?Oa?<C????y??"?f????J&???$D??3y????$???(?l2??	gP8???-E????0?q???@???????0????HG?oO$??*???P???EY0;?nI0;?^??9???$????l??.B??~&??v???w???q????h0n??4?????~Z?*\A????vw?-???'??o?|v&
???{x?????|q?"???CMrLlG????+q}?:???????????%0?d???????ve??????]EY???b??H??/??Q??Y?????=D??(??u??3m????"?D.E)itK??+?=???3?#wP?-??Bq.]????d??R$?\??!?o4???!?Q?,6d2????L&??[?C?B2l,??R3?#v?Z???????G2????A??M????????x??????Z?z??H?0??}
F????sA?????Q?'H?uR7Z|a????w]??9?$w??vL??)8??
??M(x?Tb?p9???|??????K??
??U?c??gf?=???^?? 	?W{???_??Q?s#?H7?.
E??????pMaB{?.??-?7/?%I(???????Ox?W??3<'??`M?f?;tW??^?H??"??c?????9ym??bD????????vC`??\??]=??????@K%m????	?????? ???#?0???K???o?y???????????L???2???P?&O?Bo??]Vlon?????X??????????XA??b+?+?{|X?????B? x??91lX?{k???n????>!??/????U?_???e?n??Q?4bx???W?M??????=D?H/?Mg	[g????i?16???C????,O"?q#?1?D-?!????7?/?.+??ff???;?S\?5???^?KXO?
?C?=?	?H??D?2?Y/K?&??N?V#???
G?@?P,+L?s??F?;?'?~P6????s?DIEyY?? T2*I??????(??`c?'????????LA?|??16???o?r?NC]??????iZ??w????*_T??}V?-??'???G?I?e9~??a?8?????????s??)?1???">?M?????a??cp??T?igq?I?`^?;??I???L??Z??vXT????&??????9
-??!Y?-???????9??]?????W	?b][??;$?z?????[Q?_]?+??=uC????????????!S?C????|???z"?p??\???????
-OB
????Yx?????}
-????
-??P?????Z?????/=?W12^>?V1+??:Y?2eo,??7-??v!?;=?4??????nl?e??J1?????y??{???~0U???,?{??x?b3???g?t?Ke??W?TZ$??m?N???l+:???????0uW??dd???+h;~i??T;??d?V???'??~p?j!?????N?B?????
-???f/B9T?c?DP|??2?}?&?L?Jb???t??^?B?C?$O??e???F?~W???#?t?d>???????0??o???+Oz?ef?1???(IpY??N??$@f?A???????RkksGe?????nh??????;c/?????N???"??I?2??x?N????a?F???{?!?d?J%B?6"??j?????????Ti?B?,9?Q9~0"*u.????:~6
-K(n)q
-?????n?]U??P???\??????+d??j????Wxx?v???2E[?=???????bG?@???E?8Y?Z@?%:vw????]?t?-?[????x??????B?W??E????N?(??Xu'?????K???????Eu??P'??M???+?	??
-:?OPG??~??t????A??O???4E??0?qM`?Q???~??R?????bX7?x??uC????x?f?????=?????????d????n@???K??=?m?'???[??9Z??{?Z,???]??	=?????j+Sm?????z???3Hd??????P?[lD????{w???? ??`>??_w???r?T?? ??bEV?7??"???????5??bF??????e??(/V?P?????;??yu??k??
-???.p ?p?U9'm?cr?F???\?)S????!??v?G?a??????????e>?;5>E?z??s???7?dm??S?H5????F?JT??\:i
-)???????6??~????????X??;Fi??UTy1M":,r???[??K??Q?E%/???????M4?????[q??????S??f??z???,v???h)u??p?O?????a1?{7?v5?k?????D?2??1??q?MV&?[a?;???7?c????-???????????}t?!O?s?M?[RH"*(U???KW
G?a.55?Z+8*?%?|????X???=s??g?)???/?k??????g??Az????%s?"r?\??|???R_1?G??7/??^J??-?O?o]~?DK????'(?E???|???i?JzE??a?5=?i???\?P?.??E??DP9AYke]?????K?????????q???l???I??W???X?f0?Ja5?_
-?v???%?4_????c??????^"C	%4T~??{y?1R7???M?,O#NT?yf=??|??b??N????:d?vRhQ?S?:l???????d??v?1?|???nb?s????????????????????w???
??????H=~?p??v?v??~Dk???n????}????\;?i?
?.?=6?ik???o?ar?Q????.??j?$H?????l67?W7?j????;??f???M'?>?x???????];?h?t????w??i#?sg???U???Qm6Z*?????7??ao??E??o????c??,?
?zvn?[???
-[h????3t?3z???????c?-4??????8????????7???Fg???????`*?sZk???64??S?zG#ye?T?S????2"]??Y??9?f??\?*.????f6?c?????<[{.????? ?UX??q}????????9A??i?h??T?UA8??@O????????????????Dl????bv??????t???7??3????~??x???!xZ#wo???O?R?\ ?T??j?@?R??a??????8|?3?6???5?
-}?U????3?
-???K???????{??WS?b???????u??d?K???m??\?l?r?o?{????3s?:e??W???=?$? _j}?????r???e??A??xk?^?u?y???6>yn????&?????B??????3???b?????o?_
-???9?W??????Ozc??????Ixy???????d????W??W?????u?????Qy-~??Kz?ch??}B{???(?`?C???X?gf??
#'9?s?d?????d??xN?p????$]0?H????|??s6?P???????
-???l{K?z?D??V?
;>@)??9*}9????|z?z?????1?swF}?`B[Xa?_t?????????f?7 ??o???
??]LC??v0????\??v
-B???? Q???fsoy??#???@????W. at L?????6??9c???`_}8s??vQ}?#L?????~Y?O???+y???A?z??=
-mv?jp ?%?h??=?\??????????TM{???0?x??n??#?"???,?5:=??c??l????O?&??	?W????z??m???k?e|??pA!S;?????v&??a?ca????/7x?q<s????&w?????l?H????7??`????????I??w-@??{n??e??92@?n4?y???P?O?[V????G?#?)z,?????Gy?sP9?u?y??y??M?Z??;y??d_??r??gN?)????v???x???l	?M&?Ig?]?qa???f????+????l?\?s????B?????????W??Sl???????l??G~???P????+?o??s6@(?q???7?)???:????B??	M?&ew??m??v+?!g??>P??r???|????1?z???- [??0U?m?unV??????-~S???m	?P????sl??c??~??j2!?>??q???l???f??????7???7_??%?4?k??>'??O?i???=?	.????q??7?G??-c???0?????????F??+?p?X?z;"?@PaNm???j?X????5O]???h??	?RZ?7?????/o????7?u{{'k?4??????%??v?	???#??m???h??a?
;
-%-v??{??lcZ????/?M?I?????i??aso????L?:
?I?f?j????pf??!;?$o?(???](?????D?t ?W????9#O$)??w??9???W??Jw?@???Q ?T/[?.?V6???y?W?l?:bb??????????\???$^?c}??7C????C?w\?3??#T??M???????k???yf??u+r_???el]PE??-.?JXW??????+???m+??-QE??B!]??A,?jp???
????
-???F?e????K?h-?????~??????Rd1uX"Q1?7nLN??h>J?|_?]v??[?$V 1???b????iI??B?x?TH???yB?5I?%???R\Z4?Q??I,@?y????/?d?I1O#[??3;??0??o??????G????8????:?I????'???#Vm????kame???ki?????x?
-T3)??y??F??D.????JU??4
-???\??\??\??\??\??\??\??\??\??\??\??\??\??\??\??\??\??\??\??\?U????e??
\ No newline at end of file

Modified: branches/xml-class-rework/thirdparty/uffi/doc/ref_aggregate.xml
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/doc/ref_aggregate.xml	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/doc/ref_aggregate.xml	2006-10-22 16:42:37 UTC (rev 2025)
@@ -209,13 +209,15 @@
       
 	Description
 	
-	  Accesses a slot value from a structure.
+	  Accesses a slot value from a structure. This is generalized
+	  and can be used with setf.
 	
       
       
 	Examples
 	
 (get-slot-value foo-ptr 'foo-structure 'field-name)
+(setf (get-slot-value foo-ptr 'foo-structure 'field-name) 10)
 	
       
       
@@ -375,7 +377,7 @@
       
 	Syntax
 	
-	  deref-array array type positon => value
+	  deref-array array type position => value
 	
       
       

Modified: branches/xml-class-rework/thirdparty/uffi/doc/ref_declare.xml
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/doc/ref_declare.xml	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/doc/ref_declare.xml	2006-10-22 16:42:37 UTC (rev 2025)
@@ -44,7 +44,7 @@
 	
 	  type
 	  
-	    A form that is evaluated that specifies the &uffi; type.
+	    A form that specifies the &uffi; type. It is not evaluated.
 	    
 	  
 	

Modified: branches/xml-class-rework/thirdparty/uffi/doc/ref_func_libr.xml
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/doc/ref_func_libr.xml	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/doc/ref_func_libr.xml	2006-10-22 16:42:37 UTC (rev 2025)
@@ -103,7 +103,10 @@
 	    
 	      A string or pathname specifying the library location
 in the filesystem. At least one implementation (&lw;) can not
-accept a logical pathname.
+accept a logical pathname.  If this parameter denotes a pathname without a
+directory component then most of the supported Lisp implementations will be
+able to find the library themselves if it is located in one of the standard
+locations as defined by the underlying operating system.
 	      
 	    
 	  

Modified: branches/xml-class-rework/thirdparty/uffi/doc/ref_object.xml
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/doc/ref_object.xml	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/doc/ref_object.xml	2006-10-22 16:42:37 UTC (rev 2025)
@@ -668,6 +668,13 @@
 	Arguments and Values
 	
 	  
+	    binding-name
+	    
+	      A symbol which will be bound to the casted object.
+	      
+	    
+	  
+	  
 	    ptr
 	    
 	      A pointer to a foreign object.
@@ -693,12 +700,9 @@
       
 	Description
 	
-  Executes BODY with POINTER cast to be a pointer to type TYPE. If
-  BINDING-NAME is provided the cast pointer will be bound to this
-  name during the execution of BODY. If BINDING-NAME is not provided
-  POINTER must be a name bound to the pointer which should be
-  cast. This name will be bound to the cast pointer during the
-  execution of BODY.
+  Executes BODY with POINTER cast to be a pointer to type TYPE.
+  BINDING-NAME is will be bound to this value during the execution of
+  BODY.
 
   This is a no-op in AllegroCL but will wrap BODY in a LET form if
   BINDING-NAME is provided.

Modified: branches/xml-class-rework/thirdparty/uffi/doc/ref_string.xml
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/doc/ref_string.xml	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/doc/ref_string.xml	2006-10-22 16:42:37 UTC (rev 2025)
@@ -52,7 +52,9 @@
          (result-code (c-gethostname name 256))
          (hostname (when (zerop result-code)
                      (uffi:convert-from-foreign-string name))))
-    (uffi:free-foreign-object name)
+    ;; UFFI does not yet provide a universal way to free
+    ;; memory allocated by C's malloc. At this point, a program
+    ;; needs to call C's free function to free such memory.
     (unless (zerop result-code)
       (error "gethostname() failed."))))
     

Modified: branches/xml-class-rework/thirdparty/uffi/doc/uffi.pdf
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/doc/uffi.pdf	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/doc/uffi.pdf	2006-10-22 16:42:37 UTC (rev 2025)
@@ -5,10 +5,10 @@
 /Producer (FOP 0.20.5) >>
 endobj
 5 0 obj
-<< /Length 190 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 201 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gaqcn4V*,u'LhcqMEBhUoY(EEMsqht at Y3"bDuEANSaIB@=U)8^;]&0aV[0D6 at Y@o>3i0Z4)MTJ1iB1&t1P?-rae:7E1X&Rb8&g6M;FrC6%(/e!qVF.CSIi6uP0V2E=6OS3NXG+2X=('n8&(6X5Q!p;[Rg*K\^g@"_cb"IX'Pu&"K-/idJ~>
+GaqdX]*cD?&;B(lTAl),iOH at 5G$De=MG72'Yq]!?$6qt2q-EJV_Gi>/s/i"t#!0$EmK_'.Pqq^YH!T2*q~>
 endstream
 endobj
 6 0 obj
@@ -20,10 +20,10 @@
 >>
 endobj
 7 0 obj
-<< /Length 971 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 965 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gau0B95iQ=%)1n+kh#rrlA'1'fW"8(U0G6"kACCQ*>D^tKKe#oo"8+.QT>BMS7t&b)i'2H1\Z*c&Qe"o:L8PZ8i'[<-EoNI9%u at 8eA-(@_B9KFH!D+X'B(u4EKmWJ!TC at 0]<=F_f]kj9BDHD6!*0=Eh9t7*gL3p`*JSOG at lko/P+!G169hQu!bo&C9WTDu;gaKc9)so/JW=9X:3nO;\e\3cX%97JE0lH%k[`3pYk(Ho3P#^r at XO#eGVZQ1Y0o2L;UN%J;;o:-"Y$#FVI7jL;3_!a42$$p`::QQBFbb-,=UfL^`9M4ZXhIB/gf2ZN-*<6^(oZ!YP\&r+\(fd-A9D]>Tg0-dHnHRj6fS0W0)L[Y#LbIToP5*59Sn\5,_`Hn]XlYB4RT?f)c;\`a49XA
+Gau0B9lo#B&A at ZcFA-9Z`S\\a;j*G?g8#gidrqVQ6.j%f at O*E0./ih(NJo,:9QS9/_s"58Dg.h\CL?1UMbsWT#Y#r/$p7>qI,Lur&,a4q*_%??q6/YH:;7_^lb<4qDmi3MlsD"m81?_JGV7i8eK99"_!XJ`"DOWS69%V?g*poDpTOD+NYulf9+Uo`GkpN\R^oiss6d1+_$n^?25[9&oja`4eNgk6:&60/TOB6uH`Wp6H>(0FlQ+&l1e).un/XO\^rLae!\j^aO6ZSR^<5QNT"!'A$fUMJ#msPP>Ik"%k+87<*#mLg"3*M3QXj@(^rV33`Ef<,$'],bHf`&KqG70S_>U at rObfN@Ksee2_<.A2Ype;4lNrOpK1OGTj>/$4**4VkH='g?99)V,6i=K%e<(Y:Igs&e7=Vacjr\mMg^u8J1&`_1/&r`fU3\Ej-d+>-1m at B"_3n-uBP>*n>-c\ZV;2gTE8kkP7[onB-ZrdueerP,n!LL?kH%o&<]GtKfIhq`rShqJdHX,L[,-5?>m[u-Lj:e[Q<)WeX49j5FHX;[#JW4TE1:c)ofX(CW*Oab`A*_g^'q18h$9,LL52At#8'F
 endstream
 endobj
 8 0 obj
@@ -38,7 +38,7 @@
 << /Length 71 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Garg^iGoCd.c`?]8EV`b1=.gR0K1`91K?+0ZOMGdU/Zh'Y!=Te%#&:?HH*JE!
+Garg^iGoCd.c`?]8EV`b1=.gR0K1l>1K?+0ZOMGdU/Zh'Y!=Te%#&:?HH*JE!<<-b&VU~>
 endstream
 endobj
 10 0 obj
@@ -50,10 +50,10 @@
 >>
 endobj
 11 0 obj
-<< /Length 1935 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 1932 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gb"/l95iQS'SZ;X'jS`aUiIN(/T%Bi>bk*JaP at P90_C00,E_8Q;NUhQE_&qbP"#L^e>=8l#)l=gN^uG0nBRR\=#\UU:Nt#+_1[QgF>e01F at 7+XrZb0'-a)M,d3R_C1L2ti]pcq_kMjW%dib#G*oYDF@^bgr[`Bt]=65_=[kmuZ*nk[k>E;[CX at FR94lQ!O63>RFqd,._S>_",X$6.*UdiZ6JO#l:M>4g%Fk19\QB&5Cf.j#V:YS8*o1BdZX/*mq>R?n_%t,TD&EqW"E3>:=X&&>o:OOIG>01>Q2H`uj%Xm%R&En6#Yj;q)Q^sU*q4,T:Ps;8L#j-%Jd"TqWol,2[*ZnG+AK`Rt`'_k@(qOoSiY,X"&f>dU%F[XbC"mildTZ#,"4(d$`_lKqlni4U[>)(ub.T(YtZ<`H21TQU;:SHF$"_!H1P*qeg&=[MIDiPSP=fdod>AV+F'!I5ajejRmB]p at n5qi2fspmiChBe5DODUYkfM>N5JB;Z at A\Cpb^\Km3d%X3[8B#TesZ_W-O=h1eB(9i:Le(JRDpNFm&>k`[Gh=e-O=haeEKJ:f+/L1lGou3^t-sX`h=Oucrj5D#a&C)>f5flYNGFrngTmbV%NkU'Hkc!'CBtM]@I#gM`e>]@9, at jdo;2]Xt1:t`o1,%J^0.[:tYYbZ&im!4[d"f-n2q=$j[!i0.8o!1Km'NfVY=+Q!?3'HUnJL"?IYSgb(%i at D,?'2(n&\2.">pQ"WW16_?OJ"F=BgnEeT]&W8IsM_)&bXH2KPRtF#"1E\7P4-$IE#l'^L1mTorC+')j#/:3N#kYL&[i;LfNQe>f3pp"\HdU4'%K_3A6U0qW.n6t+S#a4!rD`.A#(]$d'nu'1?FY`ToD[(uJG.X(#>qh,2B)K;5TnE6OHq-']n8e/O#3HSM^5IDGC+V/gS43Dkme!k6Et9L:=.AWCsJi\`2SMeKHSY3OcF7)ZUPiM-He&Fok?@j)9"og#]t0a,MR*1U;#T0/@08(>jUh6j=YalJNu^l3hYkp,3g%P_p1D!NZT?SgBsH,Ds6ctJO'7-%bU_JP`orsJ`/'e#=!PH#kV"5@QVZAgV>ein!!7`F6oNfii3\X6)QpeCr)nuJ%SD0K:'9:86(jDa*U at m$$]0J;7VTGIVg>1ZNcH-GFJbk1_="3EU#CEHh)8+]/",LueqhrN(ogNgd9I4gFRGrWeo$`rJ[]3U8`J1Rd>onH+OJ5mNdAkHlYWl(K0\Tb=pOE/b="J1:1nI9qp=EkN<=sR-jp*-SlqcR*_IOecPucha=SD(e>*QOW6?8(^)"M^0knp(be"gf#?BCDsmB?s*R7qN6lGDqYX&lXYH'i&l5h5bM`q9`$Hri)'0Y^=7nA"G'lCB_AgbT;SH68$8&9g/[ouPDSJlL>A;oE+Ym&7lSoa2u7p=XRFUf^g&oD`:;K5#H\>Dli&^?"*UmU5l~>
+Gb"/l?'!]/(kqGS'u%mAJpP0/ELGX)V6//mD+JTF?9$fXE)kuEFa($pq!!CYMh)2E,/$0jVCi"rL4>ZHrbOouLdk1/^32)HnSW/"M)\LD7reMB=M=1U64GgW[D\c)MXGX&FR4[B3Pmbb+b1j?!V`*Hdc>j>ml_gc!Hi%S%TH7T*TZu+X-)nqbG79P3O&D?[q3r8V=kbJO#l:M$/CLFh[CQ*?Sd"mpec#T6?^\'t#O[=)"4lKf1h$%"0?mdYb6>aDCUg-!U'BsF2OKe2LWc^h)u"\-A&cNjY7=$!?N&[Pf'Y at Wu37C*:2TK!JgoSEJ[kZ%s%dGBB0Y,,=bo#m:>%)@EZTF7UVSe)OH31QRPq3\rOnDNLL)2/qf6(!4=#3Dt7Z=V,X)[23];."9MjE*Oc)ZjUZ9YrQpQ,=LZ7`*'OW2H++:)r?MnbhH`+X2'N8ZVkeRmJ8#&1ULo#_hQU8aC*a6Cb)c]qhpe]XVF#c/)$B!dek[_EPD7G-%S+1FRUJcHJj"?JlVEuIC#1K at lFW:&b`>^p%f1Xc>j71]as+HrMenI2ba=S@:-SSH1(FhY:"_krCo+fbnN4VKU-_;#,,)Jp!]dUqoG-\\]>+f>VJ4Y&:"_;/]h_JQWHFgYg;X'm!&!OZLr-^)HDt.C:.e4nZW]=#^"]sW:.0Z^ktNlZ6!*=Z6$35q+A)B+[[>8#R#HYCN,'CQlllS=I+509@[k')/e.3JM)J3&aT\-3[fJq":,.A">Y/]Nd&k&b)n%BH'p"er/i9Y9tN/%A%2UB4cre$aU&kgRE_._%\3rK#R#]RO,UC#9b_;TKe1""or!4L1Q"LF#]t*o;)WJcPA"@#*NT+-*1)#]C2tE0X[&Nm+X:ZETSNq*CUcqHN0F-ce[=W'9FQ at I+;!c:o)X',LiTej/?i$+dGRM*!eHrc,M_N.b,ig\/?4tu?(2&s01e+56\ZQn#W/3#h(;YUM;@II=8ArH/e*P!#7q/_8D/>-S5.bOQ0MR!TB3TMT[]%[Bo$O[#]phm[-eF6O>u$0P\(]uFK[OHZ!7M8>ppS+E9Cq+A7aY)G"i[O>3/1b4Q9qY&)A]%A53C5\o]^%F[p"6.!D=?BiAlkk*<`qV1-XXqGpOZ931YKhh"u9MhBm2$K!HL1k`Hn.h(aG!.j(.E`EK9f4B(@YX=[]A.143*+OE^$fNf[HN9n`t/o;1FkmIQ`#8scgW"DpWkJl4^juc--?kDO)P-KuKog:t#/OfTA%3".pfKc*B8]E[D(!JWuYWuT2)SM!#X8rAc5]X_I5)_hkA:@m)!ndSckRiL4^7.;KepX].C4e''TViU..Dl*I*W8(j]kl1uiBnb8_W*6F%4UPd7_b"eVn6jUpk1ZbB3]u_F@(d2JdDrL(Wb5,B7:*P7ep$~>
 endstream
 endobj
 12 0 obj
@@ -653,10 +653,10 @@
 >>
 endobj
 120 0 obj
-<< /Length 506 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 536 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gb"/i9i$Bq(ru)mMOr%8!*f:$**ne?Aeto&0ck9a9+rig2N?VN(9g2Z)IjsG52l(ml20H>DkEnbbWAQ[+um at d.m/c6*^SG+"Hh%8,8(2+6J4N5R9d"J3V#OTj0SBN2g\QhAdBCd\5mfr?7T__RH_SACtl*(#RG)n$5p1ki]4S=g%h<82BH;doY-TE?h?+_3p+i>EsDaJqL,P<7_M,6fQfngj]fKuC8lC10AG=_\b1o+l88PB!PQl:-f]N5&uXnZkqP>V,+3`d5X7RV.@\%QG+6GY&NaQr[+2dS/)BR`ZHW1ZIMfn=%0Qh+/^ND9V[4D)cT/,![*9-dkIF46Q2.0XmM(2%r[`KV!DGH`=<%2h]sDPYL`Qg-k[t[[V)FQ"Mcl?GdrZB at Pjta9%0Qh+TBOh)7.4)fRJ5(AWT`2:0G8?C>/l;3M$i^g>@c%-6 at f4ORu5++9qNj,C"&n0A1dID%\_uMD<:PCJd(eqnL17]c=t)jd2n('?3$!?l%/~>
+Gb"/i5u3+e(l%MWMOr%8J at 24*E-+sCR9_Z5`H]2#/0n=AC`<>e/RZ[I-5ql2pk?nTYIp]n]J"XAo>I'9*"hOGP[k7n>DF?&%tY'E`ILdG"=SO\\!*;X2ao@\VETk2C;%e`R*`r/cPubFPUJ+IW91IYG!W`=]7?fNZgn1<&P[*j0Ds@?Mf'aQG\QNQdj's-h]lkM at T\n'&2OG4'_DWp%1>THC=il&lgnK)k^GM>jNdVF'5X:*R(;kS2,4"DC=$qG6+r^>"J:N/6Ecu]om&#[W,.,WZD,,#793(H/U.DmLHlBfT)@-W49:6G&InfFJB$OQTXA"DrSN)O]h/]ls:e-a0:gM-3dOP#R"XW0l14S>h!!*-!5_(OsS\>n3LsZ.BEf"SA=b9.GM)UcM;Aa7b:Ip.#NSbRnV-CT8Z&S4dLd%!GR68"T4X./\0G'f%F'&7!=N<`6']eF",)pA%/fY>6ju+'d[W"ao\&3Yrk'k'uYDH3Niu!,2~>
 endstream
 endobj
 121 0 obj
@@ -733,7 +733,7 @@
 133 0 obj
 << /Type /Annot
 /Subtype /Link
-/Rect [ 144.0 664.0 209.83 654.0 ]
+/Rect [ 144.0 664.0 210.93 654.0 ]
 /C [ 0 0 0 ]
 /Border [ 0 0 0 ]
 /A 134 0 R
@@ -761,10 +761,10 @@
 >>
 endobj
 139 0 obj
-<< /Length 565 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 566 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gat$u9i%iE']&@2]$uF^'M_^T%pN>XN*R-OPRNm]'o2`R'iNYNegh5jPAZ,X)r=TP`j"9=)^A[e!1[[MU948##:k<6#ci\[s)M41k?Sl+P?A^;K`GW4CUZnYVgcp!IO"CRhe;``!^#;FN%)s&V;^(O"s6A!\*CjUi]'TNgGX.T]s4_iIZiq8jKqsGbC8ec&&"O)DTiAQ8`B-5[7c!S4'K/Uq,R=Ac"-L\rRq4R8`#bWCK at j=";cm>kL?%Z+IP><\'rI;i8>"eSKCV#e!Dg
+Gat$u9lHOU&A at ZcHqY#iq(N#UOh+G;8gJG7H>pN,ee/A?2Oj^DcGFI8P:C:b`Uc314ruMoDj,+OK&hmAF[92rUngX=P2_gj.]4`SF[J0i8:)W.2\-+WODmjAOnL.X99Q.8K=i]^bKg1ON+Q(rP1kPs\)].p3SrP!">DO"K3Y*ff)*824n=t,IC_><<,#j52s!>!%ZCW>1S1gn)`A@/IKFT=n/BA%?4,Gc>o(/?AH`YtN!>>7<5\0^SHSO3$oD=`:q!>n>Lps5G6O299 at 2~>
 endstream
 endobj
 140 0 obj
@@ -779,7 +779,7 @@
 << /Length 1955 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-GatlQ?#SIUn3+NQDbC+d(%n]B/abB98D=PmciWMS(n%gh8>8RFpi`0=V]5SQcgDK)CjT'='clA1i_!c\\uRDhj9>\lS`Mq0Aea=3NM&6$l?m3eB+rjLEU\j7.S*.7E'%';M>U(i?*[VHQ==$?'L#V,[0S;%2o@%7Y,V0k_9FJAlPP6/R'1PRb!m7O0ftI6mlHVcp^5;fn(8_DVi.$RMYkBo8[K"=t\4GMI]LnCZs:787QHD^'Bqh8_Ql-]"VWBQ.(>N%?YNLG$,.AfauX1NSoLgqoF[TeVYu);=of.dp;/-QIV7T)Qq]8X.5F/9cN[ZKT.-;l1PIp\fo`gRTZpd0B\g9^:67[g=DJ$O`\-.*[+$4s>L9eJmu(g%7=h)`_JcrWChn"&BhNU.#L%%'bHj[Nf=;)Jgoip[FMAOPp^b8.s/'jVpRg_$CGs.VC$(Y=^$85#"I6_m20J at bMj:VqhBa.O0^T8.%e at Z)0T]*cV`7m+Wdi!^71/S,B4c)+6-anb>_dDBEZJBNY+$Xu at j+8C!Z:NII\JJPq- at nqcI*&gVQ5bEpE`TO+JZGM+'IYhucY%Y@[QF at 9A8s4571c3lADL1:o[3_$s!A(:A-0a`>:bt^X-q8m$j%jpaXnA[[2-KSD5`\jSH"bGE"K8h!bSIYmI6G7QK at Ah7CH_b`YkRf5Q`f25SOojp+Ao,@?"/Cipa35Fpg8[53Z50J;mDYQ6-:s5>N=rAZ4#m$rY>h)\0oaU<9cs^'DBi>[o9h#ED?NZP[X"K\8UNMrcs0^1c&l,7AMDYu3FZB^2E9Pna)lTE at n>AD!o0''>h2fd[3PPnYn0PTCfJF+7mCk_ARcT5*K2]'``&&fVDFph7lag(/u at lK;(>-ti3m<@CW$"F(UWaLME,a>GX,9l2*3PM+n&Rb0Q9Vo>- at F?XGrL"N<'\Rf/E4'\^LeX]BTe+jYtIEJWN"7n*p^[uV&fg,G53CB]u&*mE#d_logRaApjK,F_s/r>oNC(Q"th&keGnI(CqUfiLJ.u/NRk at A?$7>&"A'=dP1=;.D>ZK?j6oblgN>In`h6"p7+MZ!]I0nS'EL5Ir4H\VnD'[S_fqLkp=Ha8BY3C^)nORMJ"5aWbD4E[M/Q<3N;(QUjtOUT]0iLXV183UIs.F+du*Tr1WTu6"FPm[qijb2ImJc39#*l]2TG59=dd1.`4Thc"n2=B"^&F"k4+RG['$)*W>S]FH.b&@':FNIjWE0sfe$(i"DVV4YTAHCX9QXmI52'W(;ukqUjB.HpbgKu>P:GqXJQAb._-^_%^.EUHI]6OI2cNjPTKC<6iuXn90n;D\lGAA8!7V*S3GL("8ecc at C2k^@;0+k4%SBq_sl?I at k`RhlS<4K;9b-1gRWo"Q+8[4%J<*WP3I1G3&-Bg2DfekGn=T4/,/t@=1 at Aalg!JJq)U#D"Y`D4HeGN0;KN%a2A^jJ>d'0;Mur'9r\pD[BZ*4B.c0[9Mm^KQ!
+Gatm<968iG&AJ$Cn5a0k7ehH)<\&;?*@GjIng$"c%kn/Y(fLPFP#@iXh^&:8$]26\2T#oG_0p`6//Ga%>eI`V*'Y]_)EJsP_'q6,(SfN-qP at tAk.J!$nBZ+=>d0:,e1Ht9D%\2HQaVBOP7]mKOfIi1u>U9hXLirD'-s- at D"P03Ou5b$O[m-[_?(b`r#Ue(ekMe^u)LFD-6;(`<2Y[D7F^lWikBbF7/&2CoD6+f!V2 at i0A-eMB#1Cg*XCP&(AQkla$E_2otbm9-\\As"8CSEcVASA$H^3lSTCPmu'oK$&'m!oLco\Z/\j]T@]C$>l^H]LFi*s:7m$p5V?^Kch#jFma1uB^Si7TUn`D3p?L4rbB0bK!6dp'i#]raScBc?3AB76gZ7ZUjG/V(;[Gn+0N[)t<4s0n1(S+*3,AEmT=O'u17iW1q4(QWFY-#8UV.u\fhd/DO-^*Q3f/PY%^4Vt`Le?hj'[o%bZ4n'_,A]i-3hMNim)IDJH+*-^/P,rS+.=]QVE$Di>6aGcaq;R[gZ3h&XY.PiCZ`+33gq?[J$.IM'1 at uXd/S at EP?a.f^/CsNd+Yc+]`1]bV29(K)JEV7=Z[2$Jcqb@;s_.JCbFc0Ykqjbd(%%s&#T'asoS.("&Gc<7rXietbCDQu._d?c!56Al7jk)4T_4XGkh\ojG1%EZNU-8F74`ZGDh`a6:^#`g`Wksa+m/$^P at 6b&Q1Xs*g_ilO:E)+slQ>>9"2k0C:rYiBY41nM^SQLqTo[@p1U4j>5mtVa=P:;-V.TV#&U\'0BJQr-,s`"k'Bn0eLNWk9*IH`,hjTbUL)2#h[tjnu[K_7eG at qMVr"M%)3]XEJn>'#8D4,+mej]]3gX[__^2^5##Pap('S:qUV44]MlWFq*<6pJ`eRcbZs;$n'mk%^YBY4FJtR&P3!Ib8YP=Pjf8Hn_gB`B[?`9@!;E`UdgIe;`$ECJQ'59l$G6*EMO;4"^j57m&5MPA?)8C at 9gfT/gG5["=[nrM"RFmm$iL3:\3fUg]2Altlpk1JX<79cr6^?+7,k7d61s=(Cj=K$.ib
 endstream
 endobj
 142 0 obj
@@ -791,10 +791,10 @@
 >>
 endobj
 143 0 obj
-<< /Length 1082 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 1080 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-GasIg997gc&AJ$Cka2?Q<\I'cO"%ZU"t5Q5lDa0%Q=ubD74KSEL&:1'Od%hIZsG;rQl40/Rg4`Hh!TWVU?(.:,=d#5g/?*]T-?Y2C;rOMmP(,ZCPtX`G)-%cBs-!)6Z,K;#)Du$9Qt?(EW1"^V7HWsj1]<\'j`pdoTr3d=Gi6P\F]SJ+XKGF2O1kMjr;?+.I\%J6.Q1]B`+PVfReB$f\-6&'W'^2W`^kZP!h/.QRGU07]5lg\T_UOmYqaKYBD[JJJYu'oIX4tU3NjcQphiM=PiC>+R$7fCNDu at 8"@4E2Un,5Map??MEk)54GI0pV95D7oqTYPUPZ9=T&#?f]JfHr8qMTedKCu&5B$@:5ui1h'=^6%d[p2EOp!aXmuk-?Nf<7Gn[n'#@"pF%P%PO25`qrZ.#q's at K\J%r=CM+WdCf(;\\>Jgf3ZrGXEHG![oJ3$B'kHd(a!*0ufhsQCG7lQ$N:uA(%14iE1BRp\DRk/]Xh,*ZT]$43U#EEY&n_iEDm+P at H5VJMl]2>$J]\q9[A;Q]EB\pKX2o29?Bg:2eX^:OpltYN>J2.eb3V6D(?D)U4B,TN>/Vg+Kp[>%Rgp?h?-5>En`39?%laTCP!VPO*:ei>:2;FAn+Zk4, at 5$c_%$]7FrF1s15S^k.kOJVGg[8C##)WeFYH4Z.Z0'j6/-O)u2J`cCSkQeYTspoXA5D\M/J,=IO7f8c$r-M7!:RVdU;*EN=*p%bRG8\Ig4@$?JHT:)%5gh#`!_B/OXGRN-2,>=/n!XbRlunkS[)jifOmB_ib8\HDUN-N-Qil"oh$jng!Qgf>^N*dTEd_T6_J9(+PHNd_$I$'t;~>
+GasIgh/Ac:&:`#5_.+uI*oE&BG$:_;RaapqC"n7B-F"J*C7 at WXYFiX]cRE^1V7JbVj*)S/qk;YiIZ1o^6XfBtou?_9S&"Xg?f5K=o"E7C:nB"?dAE?t;82GAi9G8684^b!gt`EE&g=dGb+kBd$uq"XJIr6X',WG=gHLegZt're9Fhcj8MW*E:i\4D1B"Ie^UR4f5\X)]J:7Iql8'5a0Ve$$CcN]KbbiC6,=h">lt+;+/Xf;.Z,!f=.ecn]u0=[mRObCrkkg9`6U&>nbe3Kn-i,a&+58IGANK%ZtKf?pTSeufKJA3+.42qV0>Unfk"JT at f)6iS`?B), at oF<^Z2/(%'++NfD,4:T?@!gkMfWTlt1^sMb,fl[=iYlMTM9^)@VR$rssSs^JL1r$897kP*]Ob;b>U&A':TPEP;'pEo!)n1urb-f:V.C5a=t=B!CAVMM0j#t1X5L9AUcS;*4MXmFVQN&87&8mI$.nr at 1-*;qB,A7HBF$4omhV$C^bYHJsHlcJUpZHS/4bT<7Z5%4^Vk[Df`A9D(>4L9"o\f6/iEJi0Jpr(E3-Pkbt8YC*V)6M#jOs\;bLUR+'E7:3*9Yr#CpM[fM"qJ\,0dKmel-aL$"]qpedW*7Id$:F.LYAAk]-[+P at De@'q:.jrC'VXL[<173F->!i#(*oq>fs0qT0P&(X$un!R
 endstream
 endobj
 144 0 obj
@@ -809,7 +809,7 @@
 << /Length 2312 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gasar968lH%)2U?kZ2?9B(^W6Q=T8P3bd&$Ro at dg/9+a-oSO]5gg=Dd!(B_bNFS#^LlVZEJfshcIXSa&q(?XaOJQ[L*0++'F1Uo^=8mM at i\T2Cdu;7SiZ&m"n*;o4hG8NDiS=9$_Qq\9 at cuHX[f"1mSVFdk7!l4$Id\UI^2X'k%_ol^/k^duc"bQA7Ec3>R.4J2f=^)0PY\#h[CsM<'Bf4%cO4_,KoKt_nIju^kEC-6MtA9ulC+?"m`g)XZURDU`&ou2Omg9A5Bar2EHbq)YujN][nj'8n#SCj!Z&?ZkhL:_(T5M%5MZ:^Moj!HUR4c&%To='7maToB(i:,B]7[*1t6-2u at S$P;Orr"?,dPjBS$,H]I[#/[tiY:2ST:)FS3fFRqfdIRAF:+b([[B!IXD`Dh!OA,n'=A at ggV(@#iMQ%=FU`Ls7E==*f>4]0NWbG:os7ae,b]GHtY?6^]$9INF%>,hb?a*al[^k[g1V*UE"JaF+hq2eD-+:ot9`i0nJ+*`PBfkB3Tjp_ at s3hGJnp?cPIk(%1C!RgNp)?E,l9)3c%-\UGRFac3oeLn at ZTAZOWCnsLL$Gtg1Tu/`'K4UfOA(ts`nPM$DtcW`#&>XaHDr``_Ul=acuB)c].hI/2WnR/8HBsjD$Ie%Lk7++m!/XE,QVs"A1&IF\[19[6G.gM]YUs4aJ\QEd&4LfGL+^7+S8g4VgFsN?fXeLQ/BolMnmM<(a at 9d//096j5oFN":rD*E0WY,,F.8u`, at EX`/CW1?Y<,u-=XH:=:c^L--"\DFbW,q0X)]@=q`fK)2.KH%4t"Z-`mG/2%*^Q;gN>u;JS/j:j5ICV#9X^Uh=$\oAi/[T41k[S?:?,M`E at jR"iP_$"9Begm0phloOeX,ZY0T"%Hn?F-Tl',aUp[F;3TmOM<90*@$,sf7aNl7$0-7B#@2mW"hgsommqR1b3%rgP@<(oMn%$Jf'UA;f=l\s6%pWL8m7j`,BU<=pe:FRX3(`eht\QB!Pm]dEa%jXH"ckE1dgGMd5ZTJ[Z=_8r`Yl$%t;(jKRr32?>LR.$-U!F6l:^MV7c>(#@JBuE9bN&jAPnm"HF;l;dT-/Y%a9R[TpP*jAR\:F`MMLSNGjXapD9>qBEE/]2*2!&'iZWSDt_G6e8FK$Q[H=;h1NHFKIYcnB:n9=9c.7ncTMA3!d)fTNHC,iWQ7J-JCm_4;gF*2X4%o/-:0ZUqN?21p\/SAcT6i$X;on-6soX:`/X-;j//_ch0\Peb=kkrdCuEX-]TD/39j?0t`mFTgE'$0e^HH4ETV.]Dnu_P(PSI_iABNP,IZY0p8AedmP'9C?pSQU.?^C+F0Y#0lgXaPIa;N#U4HL/aGo`J*UlILrgd.)1Z6^!t[l[XUUHP]f[*M%A5H8]j\a%_r*$]rR35>c,7i#pnN[J>/AjUQ^nL&U;e>$h&k'482If0[Lb2.4YC!!q8V7Y(U0])ol5^k`p,\cg.:M;B30%eql?UKA8KKlp3Wp;Rn:>*Ljli])eg>N!gj&X0VQ!r3+2P#f#On;n0O'M$($W)43XDml,A+0@>Sa[:L2*_M/mk4OJ0H`(nT0q!>aP=?2L0Qk$:.,_].>YD+)j.CKA0q&*0Gc=G9AHg!'EME,^f+?<*M4j5M["uXWZo_8G>MR,p5#'!Oll at NRe.&Ed^?WNpOeR&uIN-QbI=s:s&"STl4q=ndQVC08'>>LRL.$QE,mV!;pA['%t)ieqFF+L/1fN'$L"hb6Ed/:;QuQEC;\a-CVJ"^etnc`O7m=Y:^(W[o!p)F!L?aii$2o='sq$--NM<<$)7\V
+Gasar968lH%)2U?kZ2?9B(^W6Q=T8P3bd&$Ro at dg/9+a-oSO]5gg=Dd!(B_bNFS#^LlVZEJfshcIXSa&q(?XaOJQ[L*0++'F1Uo^=8mM at i\T2Cdu;7SiZ&m"n*;o4hG8NDiS=9$_Qq\9 at cuHX[f"1mSVFdk7!l4$Id\UI^2X'k%_ol^/k^duc"bQA7Ec3>R.4J2f=^)0PY\#h[CsM<'Bf4%cO4_,KoKt_nIju^kEC-6MtA9ulC+?"m`g)XZURDU`&ou2Omg9A5Bar2EHbq)YujN][nj'8n#SCj!Z&?ZkhL:_(T5M%5MZ:^Moj!HUR4c&%To='7maToB(i:,B]7[*1t6-2u at S$P;Orr"?,dPjBS$,H]I[#/[tiY:2ST:)FS3fFRqfdIRAF:+b([[B!IXD`Dh!OA,n'=A at ggV(@#iMQ%=FU`Ls7E==*f>4]0NWbG:os7ae,b]GHtY?6^]$9INF%>,hb?a*al[^k[g1V*UE"JaF+hq2eD-+:ot9`i0nJ+*`PBfkB3Tjp_ at s3hGJnp?cPIk(%1C!RgNp)?E,l9)3c%-\UGRFac3oeLn at ZTAZOWCnsLL$Gtg1Tu/`'K4UfOA(ts`nPM$DtcW`#&>XaHDr``_Ul=acuB)c].hI/2WnR/8HBsjD$Ie%Lk7++m!/XE,QVs"A1&IF\[19[6G.gM]YUs4aJ\QEd&4LfGL+^7+S8g4VgFsN?fXeLQ/BolMnmM<(a at 9d//096j5oFN":rD*E0WY,,F.8u`, at EX`/CW1?Y<,u-=XH:=:c^L--"\DFbW,q0X)]@=q`fK)2.KH%4t"Z-`mG/2%*^Q;gN>u;JS/j:j5ICV#9X^Uh=$\oAi/[T41k[S?:?,M`E at jR"iP_$"9Begm0phloOeX,ZY0T"%Hn?F-Tl',aUp[F;3TmOM<90*@$,sf7aNl7$0-7B#@2mW"hgsommqR1b3%rgP@<(oMn%$Jf'UA;f=l\s6%pWL8m7j`,BU<=pe:FRX3(`eht\QB!Pm]dEa%jXH"ckE1dgGMd5ZTJ[Z=_8r`Yl$%t;(jKRr32?>LR.$-U!F6l:^MV7c>(#@JBuE9bN&jAPnm"HF;l;dT-/Y%a9R[TpP*jAR\:F`MMLSNGjXapD9>qBEE/]2*2!&'iZWSDt_G6e8FK$Q[H=;h1NHFKIYcnB:n9=9c.7ncTMA3!d)fTNHC,iWQ7J-JCm_4;gF*2X4%o/-:0ZUqN?21p\/SAcT6i$X;on-6soX:`/X-;j//_ch0\Peb=kkrdCuEX-]TD/39j?0t`mFTgE'$0e^HH4ETV.]Dnu_P(PSI_iABNP,IZY0p8AedmP'9C?pSQU.?^C+F0Y#0lgXaPIa;N#U4HL/aGo`J*UlILrgd.)1Z6^!t[l[XUUHP]f[*M%A5H8]j\a%_r*$]rR35>c,7i#pnN[J>/AjUQ^nL&U;e>$h&k'482If0[Lb2.4YC!!q8V7Y(U0])ol5^k`p,\cg.:M;B30%eql?UKA8KKlp3Wp;Rn:>*Ljli])eg>N!gj&X0VQ!r3+2P#f#On;n0O'M$($W)43XDml,A+0@>Sa[:L2*_M/mk4OJ0H`(nT0q!>aP=?2L0Qk$:.,_].>YD+)j.CKA0q&*0Gc=G9AHg!'EME,^f+?<*M4j5M["uXWZo_8G>MR,p5#'!Oll at NRe.&Ed^?WNpOeR&uIN-QbI=s:s&"STl4q=ndQVC08'>>LRL.$QE,mV!;pA['%t)ieqFF+L/1fN'$L"hb6Ed/:;QuQEC;\a-CVJ"^etnc`O7m=Y:^(W[o!p)F!L?aii$2o='sq$--NM
 endstream
 endobj
 146 0 obj
@@ -824,7 +824,7 @@
 << /Length 365 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Garo>9i$Er&;KZOMVa"RCHj3h*]MK!#GVSanPGQ$@L=Lt'E>`L at 2Eq*>UD7jpN`[-6fq\3V2.u8;5QL68rk.\Jg&.S@[(nr8INU?HF":.M>SFPtci8/Xpd7t/;-?bl(&>0i(h/>:[-Y^/2%+qmOmQt@8r0T2I\t>=DS[j1oc1VV8&L;:$s_[6$U$r9!GfaXi4Yi%'VCnDdq8E'po%]WeT&Y\!d!dqm4aE`uuZ?Ki:`PecF4UPBRis6(T];Z-4FaUcX)d9F.+^5B^nsWOf7$d]p?QfFP*
+Garo>92C6q&;BlVMXH-dCEJdrbF at _4L!bRE\>Y`C at L=Lt'E>`LiEjGqB%-BGc?H.V6fq\3V2.u8;5QL68rk.\MBU![b:)HtOXR9XZ_.,If%!Iq)Va]k#S<$[f]1^F^qK,iUR_PS3d/J)#g`t%m^J^>P;HQ)#41"cGGVN]4/g;6[T]`SR.dI0S6FXuG?D=ZrJNA\2MU."N*$W
 endstream
 endobj
 148 0 obj
@@ -836,10 +836,10 @@
 >>
 endobj
 149 0 obj
-<< /Length 463 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 462 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-GarVKb>,r/&A70VHn802r.pR/8.-D6;2#]ZLdPjb_'4kkS[=Wba*kb7--Be31:*2#lm.Xpmj/Q#bq_l]&A"u7:&RbE,<='.[,:5?ZR\F,>"D%R3bAhHinPe at Ja\9KJP7g9O-q at 6jUrU]J"4LKqb(G$4@,##>7Ie_7J-c5hE^T?t%WGY.u5kRT?Wb\#rBbFM0GQI7Omchb;WGoErrVn at m^9i$dT!B._VM[2ThBcYKV#WX;@6_ELE%6nm)mfc'bHL<00b3C!jWN
+GarVKb>,r/&A70VHn802r.pR/8.-D6;2#]ZLdPjb_'4_gS[=Wba*kb7V93@^1:*2#lm.Xpmj/Q#bq_l],-N8A3&G#"Q-$2FY;m>^OX*]#b`[U$^';4#YkbUS_O22D-8'I0+p@";IOT4]Kqb(G$4@,c#>7IU_7J.^5hE[S?t&>$=(%.FD5V1JXd]q`h5lR;pZY!=S*<"f?3.VGhKR]i*(m2Rn)?oo(eH%Yca
 endstream
 endobj
 150 0 obj
@@ -851,10 +851,10 @@
 >>
 endobj
 151 0 obj
-<< /Length 808 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 831 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-GatU29on!^&A at ZcHn/0R)h5lqNU;>)u`==-r[Gp1#IPYo^1XC>KN]tYn5Q^di)30*K)^4./*s)`FAi&oo_uU+d)#P48X&r05:U'b5:^eJ]7^Wh5?mp"(f]pg6:'Uml0J!/CH_+M-l7bhPDE!ecIS/W[9s":>aq*&QIDU`\7cioefA9='i506H^JEWA#tlg.Us#T)>HbNULV3/8O';YAoRNj?gBKqCeAd9>o=d;LXMTl/(.6=d89C975.S)]^7q-*a.IO?R\:KL7 at cZe2+K$>W(*9BtE3DQ;(<^;Kb4Dk\q+gUKkWiPi!F&^po8[u#O&c_#*N6Hk-.Eh,A+UKJuiOKkG_4mIEY7>E':7r)Lm. at -'7r!*(k;74tYj_cMQR(?-N/1?aW9kgP1\e_!^_Mab-i3609UY;5KSLGGoXpNag7^*tt(>;p#O)p)TL5"Ai5(:RE`l:mBOp,$@uE]Mq'M>h"El1]Qm, at e)[[Yjl;%$H#)i-Y2hk8gX-g7@:[^^0jI[GNR/;Xc!n+$rMi(2l;%_D?oa>1g,H'+K5gI*oWYtja=/C*kK^F$)bgE(fP%$qgd_2L^Xi::~>
+GatU29lJc?%)(h*kdGRu3(]EHH+.m4JIYn8,2"Tl%]Ub_#3(]smah=5aWHB#33J/K\VN!_q+++R\QmHEgj"YM5UBT(1Q3Af"C^mHaJXQN#WPAkd5jQXk'&<&([*5MIl8^8#W<.sF8ukUD[8qNpIL4pl=a&^F+[Xm?@SMa..s]bV5$$#V;4skq'et"/@G2<\BM'T7ti0*IuK=^5iRgJ-LhIs4I9NV:,:48)&[KDa$:N7iRQD5"!uRm,'UCZ%>mPg/DiuU5*-gDNpgs!jSER=pRd'\\E5G:5dr!G1Y'/-6^W3=]NT5a9':qj6I.!Mq,*mCKjZ[t2G1JRfiq1V9jHK"-oaTt9Z)N&2;0";++W"]Yi_iX=6Tit/*6%@1Cq+Yf`,MYe*1l'6p$Lo(p(_aM at M!?X&D3M^%].h:P%MuErS,OrKZc:*PqKrucE"IhBG22O0`m`J"7UdmY-fFO0umf at WTqn3XK_hNSuKP!1\6G"?:H_4Jt)'P\&FubRKiB>b$>+:7-!u$LM<#.ViLS75kmBFAU*S4K*OhkWtm%XmQMNFVO)E.OS"J25/)7b%mn8eUO[*]Na4kgC#lB$tH12mY+h&jE4h8+841&d!@t56ZABgDobQQ#+hWG6QPG]"OsT at H50LN
 endstream
 endobj
 152 0 obj
@@ -866,10 +866,10 @@
 >>
 endobj
 153 0 obj
-<< /Length 1188 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 1190 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gau`T95g:b&AJ$CE(m:#^b5([;mhB1C/^Cfg)_q!p,7/8GrYB00+0a$Md[2lUFM/.YA`TnDh_]iD7I1QLc&`-Sqj^->oD@>ASO^+B5.^!\q+/3nI47JCb=FXhllGU\u-9+P&"oo>drB?Hq1dU:Bsd(CHo5rPJFerm^S;>+AXpjZbq8QP2]$S;h+N'UTKr=DK+?CS;I#m at j'U4n>0-DRLS0K4mf97XMUf>1cuJoduq"R2E5`9ZC8EHgq=roi#$$F<[WO=GS_)l>`ka#>eoY'k&N=gM7dfK.H>)I?4M2?1dDgDa0KO>g1e;C`1YT-p._7B-I926aQ>RD:L`+h/1-G=oTU/K=?&_=A$dQY\-9na(4IB:5KDBjN%_VpLk)P)8dWPgD&KVpbeDIV,Clc&hU&8;ZsS&*L'];"gAJ8o,'s.4Y')N3$O*NpJcXOK+PUrA9Lsg7V:%Us:p[J#D`sj-671:i at Y$uZr at K[#BgCd&j>+EFE^<*t3E9TRP9ArDAl<:An"eoT[o:.G^:R2Y#pFmZUJR:I')'lHkk2l7SY]d]6r<=BU/IhMMn)@iUIZWY3GUH at e[CfBKa8ja*+sqLl:YMr at +D?`[?NO:"ASNQ:MH;N&>>1%,8F&h0-pr;6=)NZAD3P.KIXr at ElL:HaB:h4=jFI^2,JlQeJ7*a4IhEX`nZign?G1hQ;C?9]Mp!DWD;K879,cmq["iZF/]od+lYF*8lt^3lq at EZY:TCqL.ai9BpM9\"\uq9LY43?m;8"rD(VBQNg;Rk&gBm;HBTf8nZL3KU[_+#Z!P<'=PB<:L`e=NJuTnfcdB#bb;`6=2qRlmgNCpg17Icd>T*G7iU0I+pR$Hd3ARIW$h#O&W]&g__e8,pH!S;C[!`/TaWW-,l"pCMdnRE_]!O+SU5&BW_ at s%pi(A\52TE>sgTjWDKZUgb/jTP3k/-i[;mRhM08hY(C,Xg!r:`-#&NLEcgF01qVD+KeGAN8D-tnTNFl-$/R
+Gau`T966RV&AJ$CE(i;M6'?NMP"p)^FS_Af;qhBYfiE`ZbJP4tq]`8>Q#+Cc1t0QW7P+DChgW0gMsoZYbrr?$_@?WV`N,D:X_5^qg-9+V'%d]a/MD)00Q=.=CONto;R.mTfq)MSF6rek%4CeLX8&ooe[>)!MEaYE^T]lYZTK5[#b`=>Gu)UHUJJqD2tsJ/*8;(>:H4#]_/ljJ/]bJ(K%h5Q(^APkh0XjQ9qlPueBFfoT7-[A):C1hHuV/9^)c'qB_VOOATd[HJeFoZHhbB%I91Y&][(`-ji29-Y^d#b(F=Is<%*O^#@#JHF at Lnp?[+r?\V=57M"P3Y#:H1=E9:IU[C__+M&P;Ta$Hgi$>i)RMk/:i2TVK\44ah`"P-]LaXqOHF*o,&>QgW?%@^Z>KF2XjXklHGEc`6O>rYs>qn0Mm.-rY($0U($Qi*n![;1S7RZLqSq7tSi;](]SN:^=LhN%ia`rG:0QXpRj`Pd9&m3c/#H6[^"-J1kZD(La`clh-iSgf03D at dm\3!We'*SuEP&Hrd6$^Qc1F$).5`3?!^b=YH;TPpsJ9tBUSLVZ7M:r1.Q(N9T%=IR#CY21Gs`C!EFJTb-l0\Z$ui;,2_P.RO^j at Ms07*#+E5,*<%WlG3_e/**qF]g=.`gUpOZ4uA/q2;*P>mF.H[M6Y!@l]H2Ns@#6iQPpkc21inc=8r*itW$5*qPNMqfqhHs8ApTfl-P##HDYnoId,NRXLa_`VN&B@?ZWH:*C5Tg#D`1Hf=]"+sL=l!
 endstream
 endobj
 154 0 obj
@@ -881,10 +881,10 @@
 >>
 endobj
 155 0 obj
-<< /Length 960 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 975 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gasao995Pr&AI=/E2kfrENtL_kq1Y-V6-b_W^Z6B5&(Q#ia at OE>#mbfes;:dX`.e)H at 6a/qbi>W0?\FBb at 3&)fgW=:Gb>*W"@M-90F at ulUn3A+"WS?\O85pFj#O7:l^O/(`_L:VM9dGOmYjBoN(f@,LSecQZq[(qi]eKV%.W/[3,;*uk#l[5*o\rj(iC at 1MPjAsd]0"to769ie<@PBqu4U]g3#Cl]fI.EJ21_+5Fj-c%P9Rpf7)dMlF]NinSKY4F`qMP+(n5h2"V\A_(m4da#ZD,!t13:-C\!3'X^*-KG!)b/!;?C;)o*/K[LNKd]\5`+W]ScG:%@bjo1#])[K\;E,*^91nR_]Y=@@ELAa*[EFWJRIZn^ghm&tkeEt6fA%=>$"PWHqV:T#'Qk55&@@#tO/F4j$ZD,f]W^R4s_]Os"ZZ0`D.](7@\2ZORn*(C=?"kY!F>b`-32R`^(q)'b??q^S at P5-S'un%AC*[_Q1KKKh4 at 36(hRqGA16o<6mJ8SaKE3;*::da;YP+ii:L3SV2QF5WjsZE<'"G6]g8Q(Z7=SY"*=a9pb/KOCmg?$lqcjDlA`MB2.UJ(]P`%6T7Mbp^7DsDT!7tI6P5c)opV`qc;[fPjm^sAroEk"moh9VOd];pI;?@]R?(Qa:eOABm at oUQjP96+TK80:m&
+Gasao997d\&AI`dEiPG*\?Y'REGoYdV6/I:Wf>_"l+mM/7%76uZO?fIc3l]?+UAC"SG>9'TBG21 at .s,k at mLVJh[4N_gNoGWb>pi at GmN%hkCB]RfkO+HYHuAnjJo;"X>0p:W$If,".Q<0EJEO]dZ/rSdR&,LIWLR0#jH^^.CP4f%h+-_2mRb'65iHf6)X;^&%N#GWmB8Pnj+d#H/$8+u\8#jBnb:igT$f[k9uI'?B`m4AuOM,F2E6IF!l5H&H.lgP-[5lqmRCbSI`JoI;'$%2%8iqq&&:'p8l+VV3 at MnP!u@^Ki1LYoofN4=i:QN_kmf6Wi!M[?)2kPJq7YtU[2P\D3.;YV>dH]oJc:ET+^Sc[%]%"GaHDZq_LiETlps,E?eBGA?FpllGu':qa&GEKC^dL8&;)oMY+P<(h.]jZ+-3VPnQR1dm!s=/9->MPNP1)g^kLNBRtgb7 at LSgR9ia0Kt7pP".66aJd7<tHZ>9,%'ep^h\3eco/FQK0d8Q<1Iu%]066'7&E+Yg#/K,G^%dh0U^r;e\C%cS*<+3##bI_FRmOMjph_ku6>]g'r?$A=P?L3fDm#aA]J-SN4+3mII]ADXD%#BD4]!O^R*Pe2oSs2,;[u,lflT6`a#]#J3?GfD~>
 endstream
 endobj
 156 0 obj
@@ -896,10 +896,10 @@
 >>
 endobj
 157 0 obj
-<< /Length 731 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 740 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-GauHIbDr&G']&?q?;"q.5 at Lop'd)B[p^Bn45)$UsVP1rK0^fQ)\40Z.k(IHZg?-sdqm7i,N5AKge at KlanKZ2bFmcHVCC_d48Zhm\Xqu[P6VP*bg[+K"OnGk:b#>e7?0\KhaSk#Cc40*(][[%DMB>*\!ss6[C/f>*Bs31qd9Eh4B2mRZ)DXMDJ.Li$H?F2CO:\FKkfI_.A\,%m_MpH1VZnkI&&<\BX1*1+ at h<4ITpr_cq)[ilkCr&6:f8E)>+_6j17kq at nf:tBXdhg)9ZdV"&hQd9)bI8;fQc+rD-N7:otk(&PU,OS#HSO`5l1\V"Gg)O58IojX:QI-P_%lgr5\j]:6;O[rs/>$`-%Thimq`%J+8BXLZ*&L[UZ==C*(1g?TDmNpR#K3R]^2:q;hDQWZDE-G.mm3r0"eEPEL].(mWln<)745V]MB9#N;PgJSCAmt2 at H((3MR1gin=4UmJ8#6A\n3)"):H(n+fYr7D?A?->!:L<.[0>#6rWPU)kFh~>
+GauHIbDr&G']&?q?7(qVD;tkCQdMUe8falLeBOcs#>>=.9M3BJo(P#F@$2Y,;,q1;?f/a]pR-f`q>AbF=?tku0Q at ZV3>`n1_a"ch!"Tq=3/Iq;QUF]5n6DerX>.]@tUKS.QiV%;kaDL53bOaQVgnU+]e6qa?9kjjt5ZiUau7i`WXmMgoiGg5g7>Lll@">.l\.)'!@^7],[BZS<_;8K.IQcIT>fr\^FKA<$>Yb0K".+n`]sNB#ct$e'cqQ1.!,FSh4fj&,6lK2&,Crb-sfOPum+IhH:#1JJ@/T38jQA*=hfSrY&Z=4HB`b3E^.:L]fk82u?_hE_dfb0o*I$Sh^m))dolE!KgFDSHL1E3:ISMCLm)D5]1`RVTE;s+Y3coh[s2BtiW:r?Gbo)pJWBfJ at E#ukh8!=bXVI.[8RD!4@)i(d.*4(4e0/GiPf`~>
 endstream
 endobj
 158 0 obj
@@ -911,10 +911,10 @@
 >>
 endobj
 159 0 obj
-<< /Length 1093 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 1111 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gatm:>AqtE'RoMSLj3?TM"0:U&kErM#rGXK$bS/7][lHo[7Ns5*5tZ!%.MN!gD^K-."b&5o:N6J.,i%PC/r!31HqU5#6VSq%nZm$%b;i7dpfgM0hLu?*2Q.]rKQ+H'2WK^Rq@%5NfUl)ulr9dA#-le[62FWd;]&?-9R"8Ta*VR\@-].Xn&:P`G"9FY,*d[EW[d%kN&&`#\L at 0$73JFU_*86m_ at +__<+;.KTcSh,VutX"l*qQ!/oCc&8!)M_^MK@]+f2nT?m]H=HfnG\kicqa.4]A,qH=bZKQq7K?qm7t&n3X=cDJ;3`O+$,t>s at NRI:2'ln)>'Fu6?IYE]dYGpN\hL\$o#IsCS>Ze?Xpb at t1DWN7!C89Fo2HtAho>^mR,<+%I(&sUBs#("W4`_sSem<=Y&ubRTb"tb]if&r+dEL]F0N8R1BM`cr4Y,T/3Y;/->-&\%c1sVDX5`cNtiOe&g5;+m6UB*[q75m,VcIj+9--jTc at GqY\BHpj!g2S$B)SW\Y/](EtbuG'@T<"_`66E at DiW[#pAS&8-c\Z_Z.3HXKV:iXt2<0)ACW\Xr`i[UTp;jI+eFRS'h4>^1KFe2?[SslfX]KIWSja=,c`6P%f595BWS&8ud at QeRe7Zf"oLdrQ\imOKOH4D)LC'&_a7nNSQ)BH4S"7'iKALAs%ZPfU\djemRk]Z=NrQkuiSNI%&Vef=Hf6G.rHpa2&A+iJ8HF7bG5d)f_NY(WR9PE'\W1lc/(;YP:3U.s?ou*X^+lb4(QBO_+lLf9 at 2BrH*ipW2:FDPBkC>kpQdiJ&$hA\1B"FI[C)+)4'^[gDd3D\ZWImUIDoG^?q:4s(rVfP(Y]IgUTfLXa=\QP)0(\%_S-!a#^KgqpaDP%UUU_P.TVq\iCh:rZ~>
+Gatm:9lJcG&A at sB#e`&TLugS7!\KN%Aq;P^!(GCDl5ge1Fp-H\=-D%phj5$gOcjR\Md>O5;LFunDe@)dO=oDf73WuW:82jDJC.t[,%s.S#n14[,m+Hd;7_\"?/;QP^5fotkspA8&V=VI!?D1HgBF0V+:*"Diiq7YforGqrH/faAiEsH0c#5(lFNtn<;E6,WN=L4?Wrdr:I(K_^mnLk"q9q7gtb\D`eah-"F4&&K*FJ0>]NddOMD at t8S(oT6NT]3C(^k5iXYPK;Dd\%KKFu;('?9V*1tWb"!W!T'np.n"\hQ9:(ZmN)r3MjFjKC+R\"Y`0a=!ZmXUdAF4f`o799a;)58In`G.+,C=TJb]Q%sJMui&$N&PB)d?+_I2j8Me#33 at 0oL;p?2^guQ%?)UEa=7;rX<,Q*X&TbmqGqH"]9jWKgl_.7nT4(/o$p-1m,^d[IVIBfGJ;bVGMRerlPZ**7i\5lI3ihh"PF'8TSO+b,&6#bM at 0EguC1$4+(%%>+F.G:Q\qO1\DQNai9S./]%)uQc":OmeN!KN;fT>9dNeF$6J2`iZ[6Zo1J#jU42csgd!k28,HEA]'A30?+)"70&D2V7o_2le3Y5eDmUk[Je,=(q93p"H<'JT"DJSRi"%CrGnA2c>107P'\4\%PQSW'(D^+s1_[RcJM8%Rm]h%4)G#ds1TESM![uoWGd'@Ful*j[R]Z3n0)0'5q?nim]cDBRs>K[H\6Uq7bsEMD`g28gsD4.c.Ym-7h>KYa-Tr at .'_K^Iq.)P;f-Aq'pRtV_,K*>l%co3%.<3`$76ofP+5F[9c*i>p:]90Ca0_CFpuWoda
 endstream
 endobj
 160 0 obj
@@ -926,10 +926,10 @@
 >>
 endobj
 161 0 obj
-<< /Length 287 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 288 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-GarVI]5GM?%,CLj*1`c3WOKnP8;8`c!Gt8\TTorsN`3o9d(cb(a06-Y>#)^l*m%\!gOfR,dpcHO>#/24m/UjVF3X\u7AEM#65/]97nTrf)%gJD_`pDC!E\(=UBXN/LC.>euVo8CX9IoPCCX8uj`1NmU<@`H#BtLb1[Tdst/_[(?L6>>)hgHDE`RpcC at b1h6]B;')<&Ik[Ua~>
+GarVI]5GM?%,CLj*1`c3oqLNP!Ks-L;*\@5+_YH)KB#oc*;&\Ma"_B5JX-u%6&W!#C<,Z&q&PU_gJ!IM]3>6lg.(9_kO at X[V'#%!O8R at o_:#_2#^ft\DW\&IeEZ=@;(;+`kEhhRSR-=6/pmD4B"UbR5i8Mq9N'XH+^;XI!krKK9kO(lR]GO7CJQh[nO\nZpp.rCUggii!9\OG9Fc0uR-pY#:,r([L/%IC/b$g*0mUD0C7+(?$-KksRMe]e?G,Vs'NNLSLcDMe8rAS,Gb~>
 endstream
 endobj
 162 0 obj
@@ -941,10 +941,10 @@
 >>
 endobj
 163 0 obj
-<< /Length 1693 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 1740 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-GatTIbAQ)nn at i6Q3'^oI?<2I3K.1,cqa[I>/rB+gmL"VU1#QjD`rdlGI6,bHF%$#ml7/IME'B'b*M)BL#]+a>fE;`DNjb%0"!=S3Wfu459-1Fkeh[s7EL at 6)[XV)5plll_^eBo'cjkUe"%>E5V"M5(N1G[W>IhP;EcE(`ZTEI)KCFnYAm\W3[bn,*Ia(R_L_Nk at kqH&Z4942I&K>p11SRAJ).=,=Khfm/P]KmK4<'31GKn^&RJsi1MaG?MN!S-m_I;;hln-bU-'"PYRb_dD]$tV9Z/jBIj\S+@\t&(=ON1KG(C"B,B5dAS$B;0B;dP&La\G?]>L>!)5)/pOI6B4>>qDC-%F6HD)l<\.,Xff-&:@AM?5HC,bu_nO*XT\.ee at 2dXR8,*LDYi67m at n\KYu="?*Q6ad9)Q";P1aCpH;k^\]joC8q"JiC[`"3^)$)<6I;=S_6al.Gd\8^&)5NI!*^BO!'PD%oEJg:f[NbCqm]*tb=[dup?F@=&J9aO!Y99.+I]"k3_1KnK4r;9J7qENhE3uF0S+iYDi[G3IWWij60_Kp-Gt6"9/oM9Q$EQ6O`ItAb[-,uTjoo/:Q>B\F8SiGEo9]QO[^?^@36gMS93ndF"Gp=N?>3\u(M%6%:pnpAC"P>bt-,YqDnD^:sR\jB"5dW9Pt%%b9#C..'I6mLIaW'qSd_C*)Ib'&?2jO"jeRq`qI@[n?g]5QB_dnq\s?UMflKZ)BSPjdG+YC2%7gDkeAbF8p6S#s$Bn#u/_-DQJf0I9<6ir+5"q)AM.7C[IJftY^8!U0L4[D0Ct\(THC-U--;%_H$E>%#rHl_cRi3A4)S1bd>/^L`21m<;:[>3H$@\SsGW>]60C:3;GJi$nZSR.?Kq=-_qu7=C7 at 841u?2p/JMc1rbC.'^LRo.isqTKhXO/c+0;fCuU3^q9d.`!Pk&TKhRUR_l;u5J?GGisj:?8o5K%KLXDhX!r3tai!!PGPf(rgSK\=]gbO8Z%L+a!B*h-Q=Hg#m)K(CgaVc9eL1hhh#<&>m1`Em^GF/.E_\E8N^Ub`@/=,n_sDf\=a`$>#L.0Q6&C9Z;6N>heLK4Tr`FU$N">2+4*_;XYS?f(#n(NEb)k_/n;tSd~>
+GatunF!IkZ9XPF0e:!1aI]]j'^,U(TNItU\d)E9*MJLXQ/k(,^-e"q8Qh4_$XGa0)9mM_jJUPf\)1nM at mlJf[9J=#IY!+_4rhKDKgCrDPXIW94U1pkIMIq7.ekr)I/trAi"-0EWFN_3+ejX_Qt"=FQ+NkDNfR8XP&RgU\L&T1ctBo4$X$\ekl79Hr1@@(](c?pB(R7"+?H/sb/d13H!-f324cQL`[D-&kFWs!b+?TBRI;fO:kU(.F4_D3CG\S'$)6aimBU2NJH?#:p_m[#C0E9-Q$e=f>J.'M7=Z9>em*?Th3Cc2k[A;Pl%k]E%2J@)h;N;X5Xk7shhr8TSELf!S]9ksE=@?F>B&X[;3Gr]re8LD;nmLG=5r9?T^TQBeBn=[%R+=78nD>B$Y.6n)4_MnBkZ_gj"61_uDa#M;SZ(3XEjB!eL+aei'T?:kUHK3T==pb#rgBO0!IO0XEO.$jo at 7HmWQ`*P>;&9XQ4$b:C6G583Pc%<',B!$]%JF$B<+OrcBa.e]]7D(bDXZm7s2kk%,PuKY9(,Dd%V+KZN)4o(\(8mI'QOr6b8qP7!a=>l.RDEasAi-/(7q':4?fDq4-jI"ei\TrTkSneFkEgbbj//."O2cqZf>\8&`#m:%EPD^hHo at XaXI[InWF at uFU;X(3'(T3P?4+*j=0r0TH)7iIK26(7(P]r:ZGnk at 2/(Y7[4t:AQ1!cF#jHB*K)O'1e'FMcK>?f)Uf/9U'-`*NX&'X?I*m%2<[eWR%A[3>ROr$Gn'h>1AGi4c=A5Z(nta(1ReH:p48Dqj0 at Odr_4CrYMD,%2^N+[$la*1n2%cUp/%*./i1".om\GAktd8I-`=kL9HNM*hLU'Mk;'OaYk6H#3JSt!V#qLB+_oi1%pG>Cc@#>T]P(n&EbK;WQ?RF1(^Mik2>R3OG^MQn\^%5X:Jupm]_,jG.TeN%WA4L?#L]<-T;6%5WU0$-;nkcQ,2@@@3@%hl.\XVis>,BnIljSF3n2\]U*hK]r-K&P.=EWBP+oO>;kPdGT(KP6_?@'>OKfh")mep#W$?cB;an?]&%\Da"H#mf"A`qbDe`+2iCi%)1l at CBlm5fo#-%k%5YJmEiOAJ[;;7b-oDMS>0iF$F0_MK$-5;LO<3W~>
 endstream
 endobj
 164 0 obj
@@ -956,10 +956,10 @@
 >>
 endobj
 165 0 obj
-<< /Length 231 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 168 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gas3-]aDV1&-1WO:N9l+oXm"pP-0L"3!`tOE@@8J_7'?Mi8^;qU'MsP*;B'\'p^G;!`D?:'\JidS/;M%_1DJ=JL5pnEj..^U at N;CQ_EZUl5W0SC5obNV'4PN_cTWmHOP8*/'hhCVgXVTK1[(>;?h*rG7Nf$d^!Y5+<6[e1Q\f1I!0R-ZOJGOgImOsOrlO%FmtEo:0]`d^I]_Kr"TBThoc/Fg#M':4TR<$6?E~>
+Gas3+0akiP&-_"jI`37Kn at VCIBj;$,3!_i/EAMTLMh:udBVd=*[lj(A^+RfZkFobE<(LsSL"'&"HTbSQX=[>2e)E%kR?olXm:i'R2U/.f)11!t925/>6:^=hbdeQM=rkW9]B$9?_k[6+#34jLfSJ,(#I]\kS$2Ge9].L@~>
 endstream
 endobj
 166 0 obj
@@ -971,10 +971,10 @@
 >>
 endobj
 167 0 obj
-<< /Length 1042 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 1056 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-GatU295iQ=%)1n+pp;m\XB?(KH;!!$kRIcN#.lEJ.#sf'E9,5D]&qmGQ5*&9A%083MaWIF5EQZ%]@H962se?`"PtW#"l=,$]g."mK.'R53!]PB,B%_oIbd-6".OYP^"%>''m_QI[JCe=Jj>2sKe:LH>#qOpc938'c0lV/\*F9bF2;TATH/FV"s,3ZLjJjj'5S4R6-qjQ;E7_c(qftA#[V([9OLYeMK*b"ar#^i8R'I&Z]Og%iZ9df"C[`Ia-';80R.ph&e,S0Neeb\g3]GA<_L'L3 at hQ2#Pa'"!D.lIa at 3Ku*LMpL.WGmF3/D#Y)6rQ:Ia[5ol7'FO*"if/M9C**K;*%XZ*;>IT+ at EsY^iB6<#e?mF`RY2ct`Lae at IrZ[E]5p!-D9ugTi6M^W_gVc?@HDm2iAHh[([7kG&^1nY at K7JM<$e1(UJ3.Xl1sohGN4WZ'k&>njVs<][L)J,sOnA!V"9?"=?+pQ9$W(08dY[la#0^//.'9Y#sKC_ijh0SG(mGI4cq*EnME`3AHf!k2]%%HWOPA;)quCYIs%=,C>ZIl[F:B\Pu at IPQZUUp6j_T2u#6\nqgVfW`]aQ5E_=7GDcsiY/b>KDEjFi:0LUmF#3ER.<"A&Xs"7^(]L/?[.MeHf)t`'cC;*%K-4rMaN!iFXplK2,.aP$fP,&uEPuF#)a8.TY-`S-8q^g6MPbcE*(f=fK12PUBZ`3]M8XN>s`JVV\~>
+GatU2gQ'uA&:N^lo$f:WE.(6Cs%[bjh+kj^C%Br.TAD"?>sQklc=E$1abg+YUb6H8H*s6j%@Mn:'6-YQLMD^V&)uN=%cNo`P_=!=2a:)IX0i<$Sh6SX$37-#2_iE):tt>@SXVl\VN+o$TR$QQa)aJ.^1FqC*Jh0Z"Y/172Ft3>ENU^i4*=+T`6lE8Obqj;l1dXKNH1!CaAM/C.5![k$c1O\#X05SRQTf&.+P>aS]Y)7lehYUKn0r at fN].TI6c at b<89mC8o$#g&c^aF'6C7+1mN=/U5L(&hRscF:-t=''(t/JK=]'!H/JXJ+diESo]sDX<>(#T$nXeg$mob&iqq^4Q;L.Y)M$OAaT at nW;_lVp%HDO[K72OV29hF=O("^nNDsVGepbdf6FLOm2pK">H?shM)+-P:\I2>i//f[6Jnh4K=Ktd~>
 endstream
 endobj
 168 0 obj
@@ -986,10 +986,10 @@
 >>
 endobj
 169 0 obj
-<< /Length 755 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 870 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gatm:]5H at W']&EsgmSX\8PskKBE8?\LCO@=#[*T+MG1Q1CrrO;+TD79U29,Z#>fXgYOCF5pVB3[`88P<"CM6BLbfQm[>+c<57DL]N0,=l"3s0E"[DGsPHDJ&^Hh_ATI at UsUA>-B!Z2(VYa4"H2Pp-)P0MiKrIEHOGJjI$9gO-#P^CAuaW]qUJHuY0UiSiBI$8k_m9q0)M%uS!gg*?9UZAIC$NT2\m:WFc0>]P_FCGOqX!.lk"e>FKcp)>Kj*rSZHu>jVHCbgPlFDPt+0!t,amfXT+6+=Hd"SL<%\S#H/\'aZULP]BFgMl]gAmrVkO(F>=P%LHp9Bp#9uWb1=t08!>ak:KgJb$dQ>-*qtp[_#8s$;X3`70Ng7gqG!dj+lSAI?'Ig'V_D3+n-Q03N at qa.[617 at Fm@OLGmiE#"\bMoOR"ZV*2e at l?L-BK52i9T?2A/nGp:j?2XbU@"l*.*snB&8\F5Pe<]pIY>(jns+S at E?ET`A7/dg+8]^TJ,~>
+Gatm:9okbt&A at Zc\97NWf/@$STp;ouHDo>Yg7Vc@*XFKW.fu\)gSDTuk1^"E)ekRq4dsF():,t;PAe,6Cmg(\m$`B65]^id'<3-0.0e-ESc`6WR/YM2q=#@Dfq\AdoY2f=@j7ik'W;$T>Sr9T!OYaXfJC(Zi`%O:JiHia"a16FLCM81]7"QWKHf?k3g$U3.+/m*J"\:pJ+"CEG``n33>@llF+IN^kVp;XF!"94[jqPQK/s[X*d at f=V&25+LHOZ[)ua at pfsCbB(6&aT/R3hZ&i26o*.-A?*%<.N%%j2nNXi,",_TWqpcVFbIah.E?8+Ol_/-&R/K4?5pN6*E.',OSe;1=N1O!C&G$1c'9[NUir#_j)rii]g/`h7YUMX(0=s#?/0.74hm,J:Q:.3=qWi57Ih,86GZH\Voc$7>+PsA[d1ec+j7.tWU*:9X+aKqTs=CuY(b6KH^6>t`;H8,QM"KaQS?dd[FH,TR?%*djl(q>fsYWS\"A&fA9=SO2R*LKq00*.c;We(m]1DJ4N3a7NQ?;9.$b*WZPYX=7Fqf`RP%?5FG>!nV6.7F003uJ%+F?Y[)jo$RN/aJX'. at L[qF'T&T%8:f+>!Zn(&4\o,[.Rr$mS+.'qSja(gJ\XLIA6R_3+,YbbmEg!Rtu%dS&#m:AI6/=r$]',S1bGg3*jSO6FQEY.t3YIVl0_EOU'dKSQURD=$e?@^'CAFeC7"APjN_pV`5Ai#Q63~>
 endstream
 endobj
 170 0 obj
@@ -1001,10 +1001,10 @@
 >>
 endobj
 171 0 obj
-<< /Length 817 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 835 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gatm:bDr&G']%q&]^'*ZM_T[bBVgYKQ.j2Jm@\>X>qh+,>Qm[7R83aq2C?6O+Gj'/A)H)%F7-rtgrHbqT.rSNqB/OG5$6,BnF[:m'_pD'HiaC>6(ELuGE5:W#koRK^q5m#\IN>FLlpSHYV:_pt`*db3g4t_ at r;%CpO at .EgDl5?83(mg*H+FeO:,/a[$<,2(+W!#fD.hd9LoR:gbRS%>gV+h3#_Db^'us,g5,d*<\$.LGC*k"Xp_dGmRgHa'Iu\gANapBIS4 at fBF&@L3 at 2\0)0G61GVq's9mXkAFo2HL5(6'iKHMG^$N26MALVgq(AYr>ME-k4*g?H4>qA\L>+]EX_Dqjj[+e4Zdo39i;nukP5k09lY,;RKlEe7!Iu]Uo at Irl=/A5FJ3fB&mqdVj[m,sQ*,9X)>^0['+UpG!Gqmc)cF]eqI:=$2+bj0s?X^sr.V>LRb:d;/~>
+Gatm:bAQ&g&A7ljG\_=R/$;9<4L at A*VEbMG5T:l5\d-3OC_i>t8ou!OIAquJaqh)^."!0S45/?mGC1 at ShLG52i>=lq,r6(6B*pl+XSTI)+ at D[IU:jNWOt^8;"W;2-mG7&0VBY at 5\4=H at .'3_Z'K]BDK at tujXS`b\41P4Q.OOfJG6Mp;AVqhbHa(GrUC;d'R;b)=iKZEGr"f`Mu?QB$]2K+\18FlE9O^OI#F=[hEe6C%4gQGQk at n7*Y+Tu?TO-*%hmN&4MZW$X(ErPG\:t$i=qkJrALW1Y>/(>G-\k/8o@]HaS>]"CEGb6n5DNR$;a>L'tj at X9sNQQ1=LAY3QH`7^iUf*%IT;IG$d,aSS?O`$@i6@>FE(#Z/K-oDD$m4cE6WZ$`V_1`JJS5oLL(/WW*Z&)e!a1lK:&`b^(N6'AL=H?Pe&K+"k,,aP5s^A>opHZM6 at UO&qU[-+/qQW9C3`/bU'cd#lT5\Ji$1Ph/WJi&=PVf)l?':_F[)1dB*&=f at llGrE3;I3Gg"5m*'(b$(/*\Q#Q^`[A[k?9uFFaRIs?%Vi'*j97Y*"62T7(Hp&_?eQ1_G9^Bn^!J(gg/kIWOm6p]2p4,m^kl`&]6fC`h:C:Z,NW`&jU2Jeh->p'i,L.-q0](l_n4(>%?k@!&+em0/h6>/od"Ac7YY+Z;Cac[[Wb:eQb&\,2dc\cek4VDT"Uk%&:hm7(!N..NZ>4uVo*U]+ts&sQFK="Ta!K"Bdr?Q'lO>N+-bX&Q$k]9_EuJ`n=7@$2#Gc"9re/:V01od=(fjL$Ajr!pXsD*lGs%nO8="YCK/)_!Q.3m3'\SV+3Hi0JH~>
 endstream
 endobj
 172 0 obj
@@ -1016,10 +1016,10 @@
 >>
 endobj
 173 0 obj
-<< /Length 668 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 678 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gat=)966RV&AI`dFGpa/H9Z^s-I*cib]L_ode'3b_I:G"0#lB8h\Qh6%tc#G/h:X#mC2t,Qhr3+p.,3b&:l5>&D.1(T]3ih'3&d?`$(6E7!nFhmb-so!rN8M;hd'!f*/CV+_3$0]QH2"fUI#Dd2.0YF3UgbHJMP4#'?gr)Z\bZ"gl0J2EEeA.-<0U)\`TRY)Pj7:7V+<#]B;.1aF/GU.eDILS[\pf]Gu]8ATpA6jU7?,Mh=t]-Vc'7/HM-Be6(q8IhY;`^XH-IAZIQJp$2WL>E;"4VLssQp>;rY^%G"5%L-qktA#qbJW(gre_i.!00A,]/V$ife.,u"^/j5U-HX(4*+\tupfrU-G8-QO(a4mhf6Z2I,Oo/#8\hA9qXo,0LOAP;m=FHS8 at Foh+".eXQJjYC\g%IHdXQmfO46LeRm/+mF$b>XO>eccpFYSY((6B/8O,[[[]h/Ke^NhEFn7pE$&,/kH.TKNgh,/trfZ=i;]\V6%P%mS<7`[%;=MX+"o[>>@E=?R.;`$dR0 at U",Iig2Ne0PXk]_kV&M?RZ):h
+Gat=)9okbt&A at ZcI,#]\rGC"fH$)]n%tb;Td4KLCAN%1q.q(a/Q\+:1G$6l[\m6$r[I+.i/A/AMXL^H3,7(qBVO\c=F`%tl-';VWJ)-4P)pkUJ^WR4V.a),Dk32kC*=]YZQTj[I6\RSd5BKfa=3.%)j8MjZ"Vr\#?.i,j?STrV)V(WL"Ca[0*U;Q"h;O2g[s6Y@&di`_F-\WF*:cY/pgp]l+,he at ek6;oNgX[Zh2_3Do_r*rj/:IOO:q\`TL3Jnlb_=, at bE9_eMX2bgYdcCJ,;s/(FIm>TBq$X#ko<./bH=i,2sc>8IcgjjQ?$%]kLGsZYD83+Qf]#nmkKeOWDUr\$JP8$q!G8"mG^<\:RVFr?hE#A*kWpl`D4,-um`PZ$P#Wj*krC-QLd':)/NE1=\:H;lVY'CK2;1]<>joE`/BDR(VZmZ^<%3h6?*Z\'DEojKMXQR\W'jW^\^t>_m[Url5m?_F--1Vf!V0)hqre(ga7G`pNp?PHO?:gjUM%V,.bE;)L)QNRmu(l?-.!FaZI21uaOL;YLl+EU]n)kr!IdSrA1WCZJNM!GV$ZG`6PCS`f3Iga+Ur"2^$(!EiJ`Tmb(50:]NF~>
 endstream
 endobj
 174 0 obj
@@ -1031,10 +1031,10 @@
 >>
 endobj
 175 0 obj
-<< /Length 1103 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 1126 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gatm:h/Ac:&:`#5JbHD3!>jLRet&]&F6_S]dURtK928`ZPQA.o:$Wn]*8>Ge?9Tr^u;!"th&Hrq9u`8(o.#p%hOOZZt#e%VIKJ5#r$V+MS$;6m>mB1EbbR8LfY*5J#WXX<(9*Wt^At*9bAB92.6bEE]X_b8$f)Z:,`RicN]Q<7sD5cI=jeAKJ1k*frM=%.UmiV?7Q at RA_HUYq>$3!oEikn>AhrKUhZ#TUmc;;\TeOiQ5NhPV")_unX\NF:VM\O(k7+(JO!a#u[lZ-XM;dj>gO&gf)SLkF at M!5bt[)8+DB2URDpUDqc^#QkU[TeP[.:j,3IRu.'dFg1'cm2g#pJL\;lEX2R%nF>C+?nNZ0 at iteDbl#uZ.0uKVoJ]-XtrIn_uRDpjD[@:+liV23HA- at 8hH2%aol\iboj$U!9W=mi>pnA+]&l<1J2ZH69DAKfch\okCb%^n$JQ.]nIX[MHEf>nZ(&Kb&p]iP+!X&>NOQ2*DjC_Us=a3Vhc.h_lPnu4>1BArLodC"GqVeLT2YV/Jg[OXW_B3J3Nt8#?+"X$D%#N%DS@`PK2$tpccA%K at u+<'l3&[M9E:rh?:1C[[&b^Jb,kj!"W\.p&3!K2L-4hKcj_n>eet5i[$Zl4b>(kMt6g_K#e.VAN'p_Z6?Z%+_%Y.KdoHk[J;pD)b^g'rmiT?]c,XQ3#Hg](2oWt,9$Lt?%q[(/iV1'YKIYs6*V&2@*>eWM),)AcQfrO~>
+Gatm:?#Q2d'Re<25^cf,J;\9[0PQa!2Usj2?'h9[eZoFHQkV!#b`K4-pTq\DPCt7n;l%LdptRNpH[RQB_8Qkl+9ISZ;HB`531Y6*fgck-KcVu]./2uEXVJmjY+1!UE$E_a)2b=8'cE'?^HB^(s3i_UCH]gX_e/[:tV9)>V%#QdM!rC1:g[h'dsDJ7Z+54iX3j#/FP>Dig^blj:L#6F%`"2QE/FS:g;6bCDd+hgmo=Dh269<5]rb;@Q%E<_UiQ(L6U%3)l\Z_R&;Sd2oieF4'BYEpdj$^l9,5j1L8?Grois-/D!pO]Mc_a=^>54/R.:E'r56:UhNPFSt$hG8rV*uq3oeep[6Jr,:ifK2j,)cKY+(gftlWP5rq>cm,$qsX-cK,PWaV-1q&N9cI4`Sr`-VV/W&;/NZpDf-[oH(/.d#naNdHRfnJRQfC$9>V1m95L9W#fPh*mo.!F&,?/O,?KI>s>dpGplLi3mKlS'p!GZ!fW8Y*%(Tc,rWV at cn.E?_B at D&tjgfC7c(F"tV^"&f4qKt1Ab29?b/8GL.&9r).Dke5?2Nb*X$X5Z.YKZD%K;Q(Ok<>7F4,nVj6arB&pt+L\,TXehqfAI&ILi92O>C(AJ0#<:i*nm97oW\"bOZWnpRk#@aWRcd0cHd``f,%C!o(W at BAX[l4%Jq&4-b+GK*4rD5i?6qDD75U>QGRq,.rnP"(?5S+HRC%d:U\7'F)q=pqO`FL,_UC)td?pd,MKO;$o4kXpHZnGuVS)M)L[fBqbt8SZ1d at 7n:PUG)>kkV9 at b^>Id;j%2c0SF,Nd:!4>?]H0kg2`9#IkW'%RmJ2!I;$0:Oalqu6$\H;/4B&$0 at le+jO^jn,/2!!i$+`OORkt8lfEm99:lHF[rN, at im_&/hmbC^n%10g9Y]"\)%K=r=FENP`@7r^0E\/`UR?\20$ne=2K>%`__/o#1-`.S4X8'J1_'2sMr!1R5^>J~>
 endstream
 endobj
 176 0 obj
@@ -1046,10 +1046,10 @@
 >>
 endobj
 177 0 obj
-<< /Length 246 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 236 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gas2C3t&nj&;9rX'jI+NleWl>>UsJr+c+a,7F6qqe7_h.J+(?IJe)C]@<^jDG3$S\P(4f'E.oFe$4.D9JlL!X8YK[6HWUbie\P_u.r`t!dLZhgdjFg\8Qd3NgP3_W[6J!?lB(HYL_V^LVNbMn-nj2b3Li0A?fV<&(c,[9>E#+4[ADW`7UcG]W@=e"6QtT$j>rmT1pTi-1[EoOpt?O(?J##O2`~>
+Gas3,\I-2=&-h'AT41DE1 at FLkfsCc3/-KrSYm at q'J4>M*qY"e:[1ShhB9$nN0.&Ia`2F[N;FoFJ!Z?oH'hVkJdA7WV&_<`A at iN_&l;SRT0dMVo1J7pAX6Oj]gAZ4')tiZbA50bH37S%bPGo at brdD8r`h3LaAJnD[TG1%]qi at YF7a>i*F at b2>]?l3d. at R,Yrao)]qQHnF`L0HJ%&C19klo286XK~>
 endstream
 endobj
 178 0 obj
@@ -1061,10 +1061,10 @@
 >>
 endobj
 179 0 obj
-<< /Length 888 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 901 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gatm:a_oie&A at rk";GP0(1Oh4%+#%cOreoT:rMRol9V[(7tiM)>2&'+6]&*?/RAp,3Asnp$VUop*dUKtJg284,@&g2e`X.om!YSMb"gtbVM):`MVLlXD3/&"@*0Q#MQrG]"d_j8o%FuinFc0'Q>4#^;n]Qo-%ROj45+&c19MDk``?8WW*cgrWHj`M.JA[j"]+JN5I\Ng6bRBp,eM4DWah;aYloa?4n*<'lP*8A-,9X$Km1kjG*b831f6%5`>JqXf2BIlO6CVudM:-0Uk8Z!)Zblu_%$MjJ+XKj(4G"4_tc-R1*EEIAq#n'`HJ at riI$SA]J6mt0YC#C!t=j(]@/0&o2Sa=^[nk*5Q4M1#P#VK3Mk--73#.iWDZa$X(.nS^J+7As4:5Th5Md03/bfC7]@-ra\Fg:2a08Agl=,L%I[fN+kJ`%@(n/^%2p:`<$0&A")\48ZEc)^)pn9pXX[>`NQo1/M_SYX6Z=0hJO`tDj.WNO%<%Fu-]%2mSX_??/a-IW/hSP$N!$iulRnlAXnr"m/rhfSPC:Z2JHQO0^(^.mm&2L at g':G>!+qe578$Je/t0hIZ^_Vm!:oPQ][*q-<9pH?,\5ea
+Gatm:>Aoub'RnB3YV^'02W8(S)lU,8WS0L/>,A4G?H+$70e!ceN6BfMq\^?W#uL1h7>cJ/Im2c#F0f/#r8I_;6L98?]X#A&Kn(b(#e1`*JGBn*N.UEtr4KTO%t"h8JaHNiU&`m+JcKonKUWG5 at H]aC+a,uVl7C&`26\cONirMC>qOn'36?EE2aY3:o7A?:"+'Z=FZOQqo5Wsg\-RD(bNE(H'mUt9sLl44KG91>o3>O&`Mbd2irNBC!Fhf\11QXN$2Via`Tcb(ct6(FQcmq>:GVmTKX4u)?4nho]J6h82E5Hi at JaXA$A]A)35*Th8>-d8L*/&&.'Qm;,8pVj^hC:a3)W(\`tCB5oZ!tpfbWob7cn_7D;ZDpDb67WKB^b[3A1'*eLn;.`%cL[(0M"bTBe\s+&RsF[Sq;]71s1U8P6Bkj(\Hf$dHM+=.qp=\33>fsQonoba`S$g2iGa/7Vl#3&^R@[O$<'NX"(4`0;A^Nj?4hJ"441b,pDK"gqXafF(DZ0.BPVKlbOD(8Y[e<='p9kALC<'U(B$]LMZmu7FHf9ijupDe6Oq+-;)=QFgNIZ]`S,/OoWJFKYA$SDN2s2(_o`Tu/mWO*KU<]ibpG.aD:>k%R9e^K8r,f)[!ZqHQXT/Gh,&8W*i8pEZ*]U_1,NXu!Y>oX4j0D7%f629h/t2_b~>
 endstream
 endobj
 180 0 obj
@@ -1079,7 +1079,7 @@
 << /Length 301 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-GarnQb>,r/&A7ljp/iTmqJC;U6ktP3!IT7rUt;QH"7%u(HNW4/?<0kP44X.G"0W7WMpuIJc at V<&Kb1T_8EndSpT.Y=%1%uAZFS0c3Ai at SBXPE,\5$/uiEBp8m/PR at U/P
+GarnQb>,r/&A7ljp/iTmqJC;U6ktP3!IT7rUt;QH"7%u(HNW4/?<0kP44X.G"0W7WMpuIJc at V<&Kb1T_8EndSpT.Y=%1%uAZFS0c3Ai at SBXPE,\5$/uiEBp8m/PR at U/P(CT7~>
 endstream
 endobj
 182 0 obj
@@ -1091,10 +1091,10 @@
 >>
 endobj
 183 0 obj
-<< /Length 962 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 973 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gau0B997OU&AIm?6pcL-7#[bCZ\"IR at Zcto8n]G%P_7^Oh4QYTWJe4_HCVnm46[tY!qkPJk2C7 at o?>u:UN`>$J-:BgP)`qS*2*A$*srR67`Z_TQq'HJ%_c43aL)okhh1!rZ!m`cNE+RS&fAQs0p&G90pc'tBi1mHR>8cJLRROK&7S])?A5(7:TX-2P+6H-o!Yu0-=aF4a":r-V9`&/gIT*'jJi2oH`C=K//ltfTc$l]L(SgW(CAKH[eZ8D#>X4$%6pK at GMfT#h2%)\ttEF:iH49`K00khb-^`eBP^iBSJUlA_gdRDN?oomm2M8e$EpTaPbqm7/[UZP^JWQ!Vp>]s;&'0#Q'Jl:i=R3-,8rg0J:pC`RZb;hou`%gT?n06:XdfZ/[9:FS_T..*\%H]fqlj)g7+U=rYZ<$:Z.QrrsML>6G#hn=7l(DnO\j_8hMn&3=?Ap)O3t_B6Vf:PBjiP+s=!Zc*'@]:]H^=!Bb%nd_L/qeQ#iNe,"4O<)9#Ib`GBIi2;aSdbH!6uIJ$'6:l.H%"BjNHMh/&pbj%A>;b6TF[YVu"8`PVIu,A3o:+_"c#F?&,`]f5;k\KH#S1*ZrX470A.lHZ]I1c8 at f%[%<##cK>j6]nEBWeQK`bjD,ZW<9-V.%T`1,9md$.-TQB7a,sA7U??V=5NFcd2t/]HA2/KN#u%m',-/1\4]:URoQgu6)f.[k&"14BMPB2da=E/D:2KBAKaS:g6Du=C*OjOg)bgM$i(#=6'Jn~>
+Gau0BheUt#&:Vr4 at 2Nee/=IhWQ;t@[au\`oKi,1CAIjYCV]L\c.EZ?#f2&gi>B]!eK+5RdkPLtAmaI_EU=$SK^5!Q at Tbf""kcI=qKB>NB_Z4u`V]ZDH(N$hRj*S%n'CU\mI5Y-U6dR4uUS at k,KcgXU?p:SA`-Rup6Ha)+/"*QGBtj?k at m0@ZQkmj)3QA/Rc)gcE&W*SlVqFh'/=)8@:E7VkBqm\7AQVbNT(O+q+V6tepb*glH#;POWLY3)J,fbQ_+[Zt!TgCeY'u7B6qUiefmY5Y8XjfniaBYEV"g&s0bjF,DC(S at 3K`&a9RVNl<_IFm36]ZY9dJCYKBL)++U)a(-DR$`P,/Xn-B%cNr7e,RJ]/\82[SN'gp[E at 45IAuu@,("2NX*:2@,D27n`B at 3qEa@Ee!90H=g+?WQ)Tiii/-)7Z=S#EA)&E'22X'\DpGFL#u!+LN>YR1+14#W$+~>
 endstream
 endobj
 184 0 obj
@@ -1106,10 +1106,10 @@
 >>
 endobj
 185 0 obj
-<< /Length 591 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 605 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gat$ua_nsL&A at 6WI"Xjl4'lt2'b3B+Webu#H3iHU<$\?WW:9P(QBI5j<0pZ+?_X4C=l]5'\nB0OJ"pl#9daH5R"RAN6&n"AhQ6P`h7SZYXhX<,)btKn-m&>Z_onD;4OumSEZ"rl.k_`tWPCqfm#BLWXMMX<,qYa/MpqaVrtLL`2FEHh:Su2O!78_\'OY5p9a47/EjBRk-aj=Jpd%6>[a[.rf^-hs.#L#H)(2=8IrdW\'<$'\Pmp5r+8B+X4Z[N(ul?:H3tj@[0KA8ua,_S=QA%e8?]6B4[#F'@g,:c5TcB4P[E(Y@;Q&"u+iI-NtcYp/*@BkGu7XbF at .9AHh
+Gat$ua_oie&A at B[GYATZ\W]'$LiXuk!_%cKg)apqE`?/8/(820pE_9-g60O20'$^&/8sD75"e(&;Lg&=$=lSW^b3G'q%!R!+9EbK:^IW;$N.F0W[i,uIY$jl7ra'AGOV8,!%,N)'S2G,(/Zp.X:!^LE`]I2k-rIg/Q`T+*,g9=,5^,iGS5Wl&8L^c>Z\N%#5k=)FK=k*S*h_3MH8>Ri)CS?Nbg;>dARWVfQ4 at 8!*]a6goF0'sG+X[5\((!V)29:U1:0"5GgNHJ+n.*#mG0SWiG4tO.VJp"(q1e2Q(1hNi45g)Jt.PSe7r)[&oTjljCY?u;`8$2N\e5)o&7Ga at mVqrteS
 endstream
 endobj
 186 0 obj
@@ -1121,10 +1121,10 @@
 >>
 endobj
 187 0 obj
-<< /Length 1255 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 1273 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gat%#>BAg]'RnB3nFQb8)([>\f?V0*]9EP4G8]$5%tk20<?5LTB7.EXNs>N)dkhY8GU at CgQlSGdo%dV>3\&,3?V73bi>)EZ:%,C.JfGESb2H\kKOT?j#rAPi#"\*L[RG)p?ql0b%Si@;*kKHm/ASj)s(0EFkpW!Z=\P at 8g$WR/LF)r6s*32HWg]58_5?R;Wr0Ib>n/5g$--SU#rXW$sm8GEYGi5Y\=Ko7=)1T$.i`8*VK.+cXnJg$Mp5'+oeq3 at OBi86Qo\#Xp-(PnXYsSR-JpZ?[H'+Nh5Agp`2/6r4%F080T7\U[.^ph2HPNUFF at g_UC\>-l`Jt=a!fRN.8)D\'
+Gat%#h/D%+&:aF]+lm'QJ;Fq2I8Br&+R-1eU$^4Wm2kCQ0J[3TPspb.P,<_W.?Y;m>E2nj#]_:6mruh0IH5:Rq"]+R^^M=uXNEsGC_nd]e.2sC"JR$`'0stk=RC`jQ>c#Z>mLB6X$;hK'#7$Y:e$'<7(jcj#\4bjMl028_NG:-D4?VOr5T.i*J>j*%kcH>APW)+cpR+e\RSC-Fj1:D/)E6+0>6iB:[?4dGN>"rhDLd*gBYHhSf6jURB]oZZL!K9ck^sU75lfB?+.b$:1M17^nosL!5YZ\6*Oj5/00fm&KQX?;k!kJmGPFZA>VC"kIOQ;h?jAp*/4_pj*8="fhJ['M_o8oaFOk(Og?]*`'<.Y[;;f&Vfd at Ve/SfSiPHtk.sME]O]VU8C!nsFe%WgXCl#':H!cMH_6%*uDM^bb+oPeL6J5&skXI16UbeZSJcog"3<>;G/:rb(r'?:NV/iD1\Y'sC.*'97_oa,+g!`?A@6C#iuWtj3[kqd<2K'R$PWHr.uM\HR/]J4n%FGo;^cp9i)O9S?r-GRr^]6U.ok(+O)eKA*ioVA4AetW]!C.gWXYHa#5;].T!c8aC(\Z)D='gdQ8e/NID?i&q!?j]X8T9e at e0$:/2;VN<"Y at CQerV][@%GG=YN!4BK^A6^65%io?3gp<>q6d;[E,u`W,(M"+;ff2`!7RJk5hd=AUX,/acZ[#LaOJflM'%_L?o)6#6YDO`U=5'[6b7~>
 endstream
 endobj
 188 0 obj
@@ -1136,10 +1136,10 @@
 >>
 endobj
 189 0 obj
-<< /Length 823 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 840 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gat%!>AqtE'RoMSn/L+LN:1qO5jH:45\Lc]ie?oa[8%[j-7*Z/Q!]T9\?hB21ak$&n[X&1nf?U5Mmo<,^^;9IA.&Mu$Oi-q0YdfoTgTk5.6t0D5HaG&]tO\861W]4EI^o)27*pP^mO`uFoFm$AJSigV=RCnRH)+EL^7o6YG0+1^M2.r7I:7j)e^#3r_Zbr^WcV$SXS(.4W]Rm]JR$&LR7u[fJmu(qo<&iAHFCu2KXe:OqmaYZE@@F=FEc[7(k"';T6>1qdX'_k812o]Z-rdn6"AHYShF83cdTL(q[k$@c^9LV.aeSX>\=0(T&^lPVACo86a_U4VW9>G>6hUf+C%+QpIFq'V^Fe'5&Z8IroclGkFA+ngrB-oWi"s#BOrW.m*&DS at S,m5M;Q)UXsHSd?nI+F4l3DW9[HK+&#uV(R`3X0Ikk"H%Jl2+ at QQu'1i8A$W-t.8!`)j&LNU08/$e!E<]%Qs,dh!nhB]m80R,e9VKPX5/^Q`!>X_;:L:,Gc$GV(>)Z:,am6i@;Oasa2gUY4N5iTkjccjU3h=l4'LP3,Dg;/LmLQp;jr[/(a*cD:lc!A."QBW4;Hpre%]"e*;n031^T!cJOgchfsrEj6>C^jc6!E$-!07XDNi'.rlsohHA3RJX?.YRW\hd4?PbZC=A`0U:$VO%#.N?T6KZi?iBH=0,"qb\~>
+Gat%!bDt%*']&L6Z=@JYj*)+]O?0*e&<$aOfME?TenKc*#DlARq0JQ4mA/uW:cJ*mI at PY3cg=*0Gl*=Wa91(=_Irt at r;nuUs,c8L!$*+7i,e%6M=^?,;'b_hq;m:%FVJm.e.+O<%m[W_E$#1CTJiO's%55.gaF[`]MDgUc?0=-ZeG"gK<]',hkd?1Znqu0Y^FnLH'3llB9>4CKG*G at FB6i4;O)98Il(dgVSd&CJ,1b+b/0m(K1k[iXkl2DI+\,k[<$92';1`c'!b$kUH4;;>_Jn1"TmI%2B!`8!]%(]u>Yg5omNY7d8'L1nm8!CKgBRdLCS+6$DQDfH^jb8\>9:emn79T0k($BBcLN.+dFF[Xgm`"B%K-KXdA'A[oh!Z8E9"m[[$&9.q%'eB):[1q\li(rG[g]mOY?Xb:Lha1RBd)Zr^=;4]c'*in+qJ!#afIYl6qBIQq^Lj_Kj,K:TVN+XM@*2Ii($Y'6#'XV;LB9D7FCYU;ugCtkr!k at -eRk"MH\Dsf]\9CqVC:i93olG!<-Q=1So2+*$I/h#NUM4q4!2H`Pn0U0-#f6drHd\OlU=h?3^h>X:56V8.=\]9t+Qu5"Ngk5N$Y:&A\p?B;+<9T69Y7G'R&+j&/MX/lP&>IsRlYT"c"\EGeYVppGlLcFpPU0^B4rfb*?gGqdd($"V5*GLXePlJJG[q0fl
 endstream
 endobj
 190 0 obj
@@ -1151,10 +1151,10 @@
 >>
 endobj
 191 0 obj
-<< /Length 605 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 618 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gat%!]5H at W']&EsgmSYcjngbXJ:k@!LB;=G/3sN[VGn9bjiB3=r-^#PNF''S^^Em-giLbh:j6pOoc$7d"%I8K@?a1`@K.R.;!^+U(-n-QnJ48nrCFBj)Z<.qGE3Ami!._%856qI#-]Uu=4qVVCc8-Gn#t,jMYbWK at aV?.g$2DFc=-Cd[XUcn,4-AYbq%H79BDqZ9n21XGraMK6QnGJ+LN703mgBR%KXaMR6/YkS87o2[He1^V/jIWk$e,3amFYF*SO\6f%"!YSWDu5S%J#\b6O)8p7j'e$gPe:"!LVgjkfFWA\P59_T`QCVZrLs;tA&(9Y0O=qj1%GPWrag:e&;Yjr<(DaAn]*3_reX$)7W2pA\POS at s`JF"g^L1*;qN?m;3"kGde:jE&Pp?k=g#6*%K&4k;H8l'"?meKLn&k5A4-JS@;KZ&5=.k!RLC!&t#
+Gat$ub>-hH']%q&]IPPCp%:+DJ2E'j;5oga+u[e:QuUPR9JZ9O,l%6t%jhdS9L.:`NfVMsk'hJ[r,k6UOSGbu:k+)>rnMc5d"KB#k5]6X5ommGfBT=ZR>NS at clp\3d>I3(TP7&`'94sohBl7%Q.+f([In&`_<#DhQ^cj)0gTkY`pY=4_h*&,d-->[?D"&s*RM%5JdKP"DId$6a[a6AEJo#gd&kg7)4(o,MbPfYh=J8MQ3peCPX5CpJeC=m-g/$]f?s(laUI6K];$"N`8lV`i_D2W#[DTbiVs?o>7'h&C&SjoUr!]agpD7,CnY>jTd=cXh-kICLB0G at +m:Uf5~>
 endstream
 endobj
 192 0 obj
@@ -1166,10 +1166,10 @@
 >>
 endobj
 193 0 obj
-<< /Length 1028 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 1067 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gat=*>Aoub'RnB3i%]YqoaNU=2CWLBeu at rG'Q'k94j_+YVA(d.9CqUb^gKONV3>86NmHP=3VJ_&]"B]^cHjQf3E+>*a_IXjtt+)$V^r'c&plTt*qYUu9p[@:H:%(n7DVhsaGJ-$,Y.?D+`)(J)"u=#N,#8d7iq+m9Ja+A at B;_q\GkBpTOM>H?lRVoD>`jYB[AHH[OaHb.k,IGK$C-<[^$j[i>"gi7l15hcln:DR6UpX4;8/3.Da;.)2W-$L1Op7B-3n%'7/8-`Q8VAYGi6o!,VhgAa\e"K[+.*nI4+,[J$0f]k6D68dGe4u=B+0)&BGaq2#&hNYf%&9FU=N)Rp?m8'4[#KLi at rqG%aL4`mnH6(D2cVSQE!@"*_8*@H3q+)[ca.k%`+a74Zr"gDZ":gKH*PJSr6/,^*,V&4I!KP^r(g5/&Ih?/*Lld=]WP=>k6t%K>"dY:KB.9JNE9<9OMUlR;9pb1G(FK*.g/i#h\]JWdC+hVoKDZrVYk..Zaa;ET16X7u9c\Tbnu#79n_cOsNdp6UBCURYb!cPGV80K1&S#eVZk"H at 6;K84a7V]8aA&g95OSHqk4RfW2]ofk4o!m@@lNC1>MHYiC?1 at 5oknP>F"hRo\o$B^oWjdT9W+*;F/B8L>qmOmhatK=h07N[6\47GBL2cN`23tD'7Q6c,he#15D at 5nn,3W#FsgS-#XH9#4a[1l:]8V at s-FFVbGWn)KL*V;E:e!hjnAqt-]/>T[JqM.b)Z],<5'p9;(hkL344Sm~>
+Gat%"gMWKG&:O:SnE^+$:Nb-=AQ9B;$L,6/_j%Z]FYl[XM/B%uERM&>fU at B=)9E[2kY]X=k]&KiW?dgBP9s9f=MYDh"F9QE,!sc46Lron=6GUOD7P&7K6ZnU3.AQ^(U*@;+10l#5$L<_,Hs7N96EL"BYsF#&ff[8j6==L:o2e/tZOS1UfM<"k?pLKAbkERXh`?^E87PXV)?S8NUBrhTW#]9.6&+#$.na>bstCYAjqKK$N$+.Bf%BW;D(8)<^.87p"77683hkE/sS?fAB+?)V31.G>i/'F*djr%T`A_:8-fDr\*C3dBG'=qL;d;AG-mA%+- at I$UMQEt`B+`quL_a<'t?>pW*iHim4^4NXeG!?ttc&7#b22/9.G)QiF5URT*-I3kqgdk&6 at U9G[l8Dr_`L&_nCC>:Q_OM[N=6Xh>?M4'O]Bo7gaQ"%NB,+:hHdj#d:DoAGE(o)D5QG"Zh7]17\B\=Sjk1B7h[FD-&f8u;Pk&@O at Y*\pN8$j:B.;9WO^C#=j_1W%3Z8"N6`0@,nCIr3VHpHX4tWf%_%Hp%-#sXPQ!Z:OW69nDq-dT&5>6I-kCOP0?"3k2+]\FZa\XMoa`-FU`;%1[!lt/:f^o`h;H41QRm0G9FM+a
 endstream
 endobj
 194 0 obj
@@ -1181,10 +1181,10 @@
 >>
 endobj
 195 0 obj
-<< /Length 235 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 173 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gas3-bmK%f&-1Yc5/eN7i&'c&NdDN-cln5=(*04%&5(1UHMl?Y,)DW00L+GgDT-(a+=:WaJuo0l8OssG&u7/o0I\8Y^g:Cb'T[n4L:V6EEsPXeN.rcm#e'DF0?;'aKK[tQB+pBe^.5rSPV^OjT"oL'31O%W/$@>'dpXg_!WC0_B>&piCd`0u?H`V5T?C(%`#W.PWi0_!AoR]e2V"c*Wf!V@,ms=(`n
+Gas3+0ae%;$jGQP^ETE_`hZ>4hKkiIK-4\<2d::k:5f,oX!d'SP3%i#pc=&h-D3%I=pDu&#]`'oENa"c7hX4PGaRlQ51(@2BNnRXgrK4M;l,$@cQsgMr9q7+n[<8sI\5Ok+05e\(J#)Y)D3Xs*e[*aX1o)5ClW8B6C;hi4~>
 endstream
 endobj
 196 0 obj
@@ -1196,10 +1196,10 @@
 >>
 endobj
 197 0 obj
-<< /Length 1072 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 1092 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gat%">Aoub'RnB35i#'_%1ceG1MN%V/Xm8XU4/J8FVfT5S,1,c!c/I%58*0)j.?I(N^t]>G\c+Rmt8,4Ka`kQUO0*^kS7N.V\73:bW*n)s6l47I%SQacr)bD0U3jq']429AasZPub$C7e=\>-S`*cnqq)N:S`Bm7?bB?#%KWMk.M,\9`-le+<4LJ74ncVkOi at V?#IG!5:T5-k=T39_O`T?EAUNnR8-EhF3+!>2/l#u+egMT.QT]QrjR at L#7!cV\tn%'JP.%@@+E[rm'f&g`4r^OeGTmFH/H$FLJ`sTD2V\+eq&P8(%2HH\^0S^)AeS"]CT?Oqj>Nd`mA&O'0DHU?E[)mO0Kl3`6]!Tc#V,L7g0k-AT_?T$h9QbNSbG!<`E<>b-.;W1k\l?@TT%7oo7GV'(!IFGcrirGgV*ei0'-]AO`-'Pd90.?\WFO@*)PApS?lVi_%L4lpH&pa$J<&-;q#!5$X=pkZde5L4S/1^45Jf=?WE%"\VkkY8U"0")jJ^X&Ao;a8LhYOG!pg6,md`R`r]b790]nlQ[E8TJ&q+]ke at jr#uAg$Y>TAqb`''l=N0`+4UQP%Y]PpUe&`k9pa3hFlk%%=]kXID>0iWh27O3j>t at qVngp'U.boFpYZ9Y:;^0g75J_`@)f*8XMjJ?')KX-=1)SR!p4(N+"ep>NDm:Ma- at cCL4ZB7#>4TE`I*4>C9Z1Y/cD3!I.MG.s[doTQ4o_4#Tsq>lFuErNOc~>
+Gat%">AqtE'RoMSLu>+nLl$&\+G$nV:'-8DBS at 8FK9nW):n%S8L%X?`>N-o$)l@;6O6>PEqp'D5ZX1;X`?'s_=Lns1qo`4pr1_E;U-^/lb*6?;\TFAMIn*0PQI:A7f-BUNX&lI3os3A&djK>HEeL3hqA"-TQ<:6PBVlq+5f"'M"#.]"SI$F7gY!!Kb=``fIc-7:%is=j1me+V4d4fZ\L*NTE(cg=o6$E,/C>]"cXs]MQl0mQ@#pg3f4Pc0UTNK/!2pnWS)p5#NWM-0bNcg3QGjpu)S[a"X;"p:afcXlR_^%k`EmDae2IjI.jqTT1^Q3aPpgiqI#oa__B],GF9g-OVp7)X/Dp!4rC>anNLqZGN'Wm*0^]?]K(CV7Q@@Vkdik0=b24&`kD]7`ZXL1?7'Z)d9?6f&Q4LKHQ"?iIB"Al%U*d,c5^-eUkL"o9QJpRQGHL9%+`XPHT!Jf)d at uu[KeWdfTGFpaf6kR2"4R!iF(B$85'/2?LI&t2'ed!"Sf#HIHHTeu(/C#+_?md<(cB*rU!.];9JA!pePp4Q#U]h]HnCG!kf1*dgJ=/\$VRdh6Zf!=T.3k+2go'+A&_+Go+H'&aU*j=F9]>WgmSVE7pR'TFs\*gK0P318.t*]m>?b0<`)W,#A5Be*OdV:HhT%9`>,IK;r5~>
 endstream
 endobj
 198 0 obj
@@ -1211,10 +1211,10 @@
 >>
 endobj
 199 0 obj
-<< /Length 1013 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 1023 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gat=*?#Q2d'Re<25^c8$iSdT%UePU3<8&B?9hkAfm_L1rAP.IRfp[CT)`nlBKks)P!-bH3>!4WdP7Ds at .:]P9?*DP;Lp[@7I]grNA?lBfJ1dph9K=>3&AiZ=J2)TDo-9F5*TP9SVW4.+J,7$2WC9lRlh5 at B/\BgsX!m&B at qAgNjh=?&U5a%s:Y2Qb+VY#N6Z_6W=iFrUe7kN!l2X*i?tRl:Y.d!M:)DsQ[7E*aE at Xi*0f^*A2^&V5@,Ap_Y71n.".T<*LFKYdk5\q(8UD'H at b8`gO]",=P_'HMOa^R'AF8[M;12$dS]?$L>F)[(kC/S\1>QPk-ZuoH7q%aH!2E?OI"e<%@a1FWqX1:j[Z"j=&Jo at f+%$tshR*to`>uF;J7bDE&[XJcVWpjibbqjW:qB4>]#df$>VK!jd@]>8u`\Z*_Nl\uGL.o9(3'Lnk//sic]>"%:Zp"coa*dfH?r_6p8U(T1D+ot!oicq'nka!33mEmC]1K$G7X#>NPj5Vn3es:(Bb\X?@-878+c$Ei_g&]'q_Y,^3!:B8q_n#Ad.dL9MmZCh455\'be)?!RoCk[)[b="gfTkRdpZ!+-a/Vo5P_'GY%tQOfpCKsOCe7_4)CeQ%5`"2?MlR^9Co//&5]4#H5rk\.D99^F`G#7DIcA>8,'Q\$Ii?""(GIK%\1_Wh`-L-~>
+Gat=*gQ%aW&:Ml+=Sn>JMX*?#WKhYWXOKjJWS4^49cmJHZ;_-,6e^A2YAGlr6:+nM8;uU!S2iAh_sMd?qMkXD6P=olZ9Vg,^]h(kgidYR'0)4qaS[3Q2[7BX'I`]a3:\M=K=lt$m=C5%hKk_8m*>@O;<24(T]Z#F;69?6V,rR`*@QOAMq[:O-**d'$`W1%L-YrO5qZ-23<5gQ,1+Fo8Ti@=1/@^IJ*qBq+_)e>..P+;8iPQ\f#a at dLEnX/CCcoK(F))T@=Uaes?S>_98CELOP9g$WcSNq9AhHYeoj_ at E`FgS:8nj)f at A:X<$n#mN*plLWlU10/*dV0Ou"!K:HC#]"[S\_'&UD-3:T>Li(hl&iQ<"s!r?1`"=reio5+ameWFOGW9d-i[h3o#_&;0)L0ZqjJ>)Sr6RbM:@79%H/]3`g@`qXC^VZ at r9Y;t11B4;/,bMD!09@?(Rkj*4Gn<)%N.J9`*<\"]?Ff5PZ1LHYLlAi7\FpY[&WK\DQD9g6 at 1@dqRZF@)(%cgH!qs'I.dpHB:1N"I[X7bIbrAA;!qduu5B&A`";\C at 6c\pQNGb^iiFE4#N0YqAL$.q-d'e\PhPmrCf~>
 endstream
 endobj
 200 0 obj
@@ -1226,10 +1226,10 @@
 >>
 endobj
 201 0 obj
-<< /Length 687 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 698 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gat%!9lHLd&A at Zcp6Zheme=bqQ'0]]<)KG at UmJ(dJsVkU`\(XVrqB\,#qSnl`FW0Fc("HNG.!'^a9AX8 at -SYL*jpI;pZd#]?j^2Lo*2bD,h4]+#;J/?`l0NC#,[>utIe`?,I,=13I:haktIKJEY"GV&TMGBYiS;(98?kepL*FlhW(V[lCUFkZY[)iUZWV(q5M5Cr6Lq)\1W<'cJmF,D>o[>-eDs+ims(nuOe,-N:jVTjq at 8gBpYcN^$f%&Dsq-TjY5dZq@;kb[Ji?K,@"`Xto#*=tW^16"c9Qd'`@$mR*iUEdX,7%Q$I9\I-]4q>2YZ^bA-YK[l*O,iV^MMb9FV3"g8V]18aNu2iiQ#UOB'?2riiJr8dS2_E>>N&ptbisRm//Gi3(HfFsWfuU,;W`gd]2 at Ooq3/pGSBnWCIg.hKCe%*T^W99XfW~>
+Gat%!bAs(+']&?q=saX7l7K8SB9LhOFOJBT6G$sD+BZRh2Gh3&4j9O1Pl#\`"e5)3!t*?bON>h^)#8Rr3Sg8 at sG3['=CL'CR!P$TuJK+g at JVtDLQg?3("Oc^78m5sXJ`/XY>d?.Xc4li-Vhht!N*>^ZQc4UMo.LbWK?1-$s'7#"HLTO4E6"o;$PT#(KI^#1d_Becn3p2A5d6j&-`L#g>f9;GF!-\GLAeF%9pESQ=h3s- at 1?YK3qMq/Y%6k$nu!0_D^D$=Y>bF56Cp6Y"p.J)8N#EX[WEs.UeR2"*p*nhi0s+bUeiqC/Ce@=:>CS8',[k0f%)?N(_h=(]_gVDd$?.C)g at gj[e=R=9Agg@;a'5,+kj5`~>
 endstream
 endobj
 202 0 obj
@@ -1241,10 +1241,10 @@
 >>
 endobj
 203 0 obj
-<< /Length 652 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 667 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gat%!9lHLd&A at Zcp6ZiPme=bqOV62-<)KG@[$ReJ[Cq[(0MoPbo'a1-'"m.18%u'[IIh(-]Rd[?qXg$SX<7R9)Bk22(a/jr!#+FG&ogIBO<4YRa^(d\p?>'MC0#4mcg9X4;N94Ef)7XDtL!siFpjD+%([.O'CZ:BPJgNKV:at+r\?3+9c5- at pV1`"r+oQeHD&E'$.GcU51aL*M$DlkoSM6c`;o!8.,3uOD%$^'BG14`aGM33odkU0X1bfT$*SgR'a$f7!bcNm78op34$\W&\6I'.:&W/&Z[,Nk+el0D^TtA.gKQrg4q-DcA1+6]^RV4idc6BC'9+-$_cpaG]Wh^nQolXDFR at q,&'joFKHH[mo.!d4oXFj*oUcGE+nqbscFsEX>ED>3UUt&_;(tO:hA`AQ]A9
+Gat%!bAQ&g&A7ef+-LNiiG+^&C*>0;?@?K/NeK/Gdu0Y%4R)>jKD;g##6:`Bi7AB^`DQqhA"WL16?T/-fZ>+C`uTXBr,1>N'i2O##cY-SencO&j.70c+nUI4;%90Wj8b;W*__LH4D6[[//qDWE!OGA1F*f"]J,RecC8JOpfJoV\9knYtT^EV$O$%pEUK at e>1":@o#37HBU6&OB([d?L-;k*=3>`Un.F!)l(N3%rM,DKIaLX`CDIl)l\lph^nUK<.9&EH!SC91`N3gttFTRBp?VJP;e`;*Vo_Og*#sh3sJ`
 endstream
 endobj
 204 0 obj
@@ -1256,10 +1256,10 @@
 >>
 endobj
 205 0 obj
-<< /Length 422 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 432 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gat%_]l(\@'SZ9D`>q5mY(%(RN1dUHKoddp;q3%e%ZLT$Fe#.D?agN4";HNp**`0mn+o"Mb37fP!LY/@ZA^JR,6HMG":2ta;rA?e_*RMJIBq/mC'l%*?^rVMK"\5Ri,ac2l4#Q*mWNTt=B"I$I&JQ4Q'k>iVWhIP,`[L`"Bj6cZ+7:j`'!Ws*`Z.+l')<(hHpHchhU/Xuaa,(I$^iU)=7j&M=-6=*Q/@(RF(loH^2Ms/>j*8mEejru*t1'U7!\[$8HpSfi3amKdA6MBQOZ&Y@'G5lLiM+l5?~>
+Gat$tbAMqd&A7TLHV>-Y[10S'R.PBsU.CR5WU575P9M;""`rnbQ\5nP8VnoLZe!FIGh+DikO-Fo.ZjlGV%/'96\3`/"j)jV#WW*@6aVKTaXZ/H.==DQ>dHCd;E*+$Q9a-^5QhLl7iTHA=50jHPbuOo`nfgG2QE-=_.EPk4*bI4g1kM6P3^Q7g779A$TTP#'RdOBlZ,!pOG*aMT5h/KKhic[4@]
 endstream
 endobj
 206 0 obj
@@ -1271,10 +1271,10 @@
 >>
 endobj
 207 0 obj
-<< /Length 1678 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 1572 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gat%$=``U]%"@rSd-O,h4GX_p1HXu_dl8 at l2YK'%CaW0U6*]ZV]/mScf'E>3nrc6YG#J2 at J-ce^!.pk^=-K9E*$HK[1S"$@XbX3Fa'eQQte+WR:/(4XtY9H#l^d^RQkM$Yhq$uU_^88X8NCF?cp>t-2=662\)*M_M:'ZYUfY(+0Hmr"uP[gr:J`DeVj^8dU6lPjlPZ?-*Foc.W!3.!A9OlXO+U!dat,hCS_rrAiendkDknZQ89P[W6X[Emhb=>i=iLh\L#W7_o%cI(E*PItHiGfrXp0CP+cg,+gfg23Ve.o+ZWhqDYX_QjI at 27E3g49KBb?tDWH#94;Bb$Ql[#h,WXe at IT]nVbB2D.Q[25JkO?HMGR"D!gfq*A5]R at Y`3I4=_o5Cht.epMD?;B21B\up.WNWJ:S!#YIPFaSYJ5Km0DYU_"'0&?Wb58S''$$9,:#Xf"6`MLtZaN&F%)J'YfQ*sAp$;&jG3)PZd%-UEWIBKnNF6'/oG2P)+49r+#Rm#'b9fST%(F#4-\c>ndR6Ef07EUm;ScPtA#6L#Y7E_u7bWB-pmsnJrgg#Y4H:YD_D.G+3>':IO!39bT>0b*%Qnd>-TUh%bpg7mV]jXEu:UT",*W@=iI5YM[b3]$"TQ at kQ![Gi_d1MHo9Jll"-RC3T<>V'>(deBa$i@'phlrOGhQW71jNpA04KZ\RZ&;fB]sgjbe9(Q\>uC%t-N:/OkV)Ub@`/%X"uf?`kZZ]WAs%hfV6Ufmos:bpek.KgjJGk%6#Ojq\9cr6:]eWj=+T&^ccpNX[[MT/J)eVbDd:L=E*(C%UC(c&-@\^,=8djN.N_qT(5ZO0-=Ad(X'RoK$et[dkl49F~>
+Gat=,=`<%a&:W67+S*n%&)*1>E_/<*!P+L((U947640LQ"%B=C-9Mt`ER\?f]uX=tZJ*/K1TR)4RtJ&]=\jLXZOP)FfJhCYM.o(J/Al"JQJl7_)C09a:L%D#)LkJJ at 7m_^^Q%pT9Zf4DP?hQ_NIZ`Y!V%o8CeIC5`7893Kk3,'k&FGLil[WsQX?5"0_U%oZNuUo1&&-cP8fF.La\&k1l,-u^bn,rFA!plA["q&1k at PqL(t+nca*B?MBd\1]jt&h6]A2G^]#4iG`6YMM\EED-!$Y at S9_EifhY>Lc]bQu>4:W'^M.-.X+ql2K+N<>.HTX8^85C?`5a at QZ\r/o3s^q)*@\Mn7\dPhU/cVn4C`]D\pXX_)fY6R`%j:rUbPi1r&IF\+e)'B$:"f!`%cRpJj->ciM\,,K[EC+2AH%fPHd44 at qlIigS(AG#oKcf%S=$O&S at o1=7(u8l7Fc(BM/9f[8ppa=NtF8*uV>HCcDS\]B8K#=mO[!_.ahE9u?9F_+fn3"?]ChCVju(2J*N at G`\5oPb.B]Ec$7[cU$coWcKP`]Lb!E25`r>UmMGA$RNmZO5>W]-d*PkdhI\TM^dO*TbtP3f?tKe=eGi0`VI[!,`U6Mn9k6K^JU[f*0Olb5CdLY#6lImk^V:qVXUbdauZ70Q23>]`GiAXPgsoWl$)BBu8hA:&:61OiGCDhoYD5=Z*SVC<`s%S2RddO^8l12YN5F"jI/Wdpo+h![GmSE!EZI(H;6[7]ot\gG*IkDS'kQnNYaiFNpZm?^A8Xg-/U(Z\g],g:(udk&.R.7MMDf6Qk at BeJph/WKVp7Fcjdc0iW+o:n<#>h;=7ikHWR[Bu<\Z-d3$8JM]#TqUn'YJ`Sk-Y4u at 2]1]YWiZd at aW!AdUWmWra-?L[%nW+o,e`#O#j?h*[2+O,FQB-N'?aLMqcLR;3YZ_IG^',<0/9QKDK5U-dnZ[=el<,[YrHDK\O:hLC%DP`G'Ga-9+YBS&U?emkFWdPTZZ_rjHH**^OC`SCq:rTUTAAhQd#@94-H6in`<9TtR9a.<.4o\MZ-M^gG-W2.+7#Sn_14I$[Ks0ec/=PYN2<,Jl6F1\M^J`f$$%a+#qpT9pV[#N1VN3^)'[N&XK;<]n)@HT8AOLn4TK!fTP^;OMuB5AR.B6[AN>E$P^5eOo8HusLR&Z/o[IAn0'psQ>A8GqBK+iupP*8rlcBt=^BAQ$it"#U4*'%c<'cNBjMU%jh7lK#A<5S_bhDFJ_&a^%2-(_29R[4`i9R?~>
 endstream
 endobj
 208 0 obj
@@ -1286,10 +1286,10 @@
 >>
 endobj
 209 0 obj
-<< /Length 250 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 241 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gas2C3t&nj&;9rX'jE"Rf"FSZg'Y*h&B*nQ,(r>dReSkiTC9`iJe)C]@<^jDG&#!0(5!kXYb`Jp$45c`JlM-#8YK\!#?V4hVCjQU%G83eC%)>X8Xk(Q,cm+"U^O$n]K!L&WO%!YO^c<:;o0*I.X0.k_kfj576Z6VEGWjCMq!V_=1Tnt,fX5`R_1Zt:l;*:g7G3EHBL4Iqlan&gI6C2ERD%jC0-pTZP.uf03XS3[ofDNJTX):*Y6t$_Z~>
+Gas3,4V*,u&-h(+^Z%^&3.%L`l:QY\K8Hk&E?GCL6ij,RJ%eAL=H'fPc$_^@3AI'P5`Ej;gBe155p/N,YX/XI%GK<^42E8dmq(&F\o!>b"Cf?/1IE(TFmZBOd-i?d"h+c7!KuD(ODg0/cq(9*:2'9cD,]EZ,^861^45RUen@<5ZOH(r_+q("k!#AG6EA"u7H2_,ec$,H7IT9>XW(VQIbUjAj=d&p$8[m?I_hJedK>;X7?I~>
 endstream
 endobj
 210 0 obj
@@ -1301,10 +1301,10 @@
 >>
 endobj
 211 0 obj
-<< /Length 1348 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 1395 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gat%#9on$e&A at sB#j at sg@)\"t5$R*PBi:Tm;'UG,ETc,oiurEF99GM_66jqil34WJ.b(m/>Pb!QWje&nj4:>'.E58F+Ao>=[i=o1D8mqB[T.NhQ<.5%N(Es2MBPe7%+FmPhRWL2!UVe3p980PibYYBZ[.%@nUk%&04?='(oKm7WO8s1'$#Y&NoC\T!<\h0KY<.7PRV?1b/8c#3KVo6Cd>&N"-?2'iO-\5mtEd#)oZgWqH'l/W#$tU=()'AW`GG967PFeX":P0pX`7Om+i6UE8WVp*Tf-JBK9!ZYmG?J]Q1.==(=Yl#@PYK>(r3ij`H-qY9MhT:Xjc6aKW8 at Q`OKkC[.JGrhk4rSpH$$I at f7Qn9M"gb9O)_TlXjiG at J["\/(9"Zc9Hp'm;i3Ui]$SsqR^DG"jK_KKaMCbgKc*t!a)RBHT/OY#k at E$7:DX`nX=3dlpZfZln&m5*2^39fuKsil[%!A#- at 9.^r1%4]e^oirminqm2al?(]:SP>W%U1=&(CKkYZ5Hi]n"%ka9r#_W4]Qm_D/44EIC=kTt9$Y`I*8c.]O68Y:a/\J'+`P:?D!L*F8?*m?@"e\lG=QF6.5k:jtV3ChlBoXT>3J_KVq-5Z#=-IBLj<,ZOY\uS9D$G&a-r^hAgD,3hiDn?Se7HqcE/me/(C5Ya-g?1g`SQQ>Cs=B at GPFQL3+!H`QGSR%*&4`1E45*34M8`iQJV\!>s>0'a6V-E0,+sjj^TG#Q7ObN&]Wr=fPBsU.8t\M-*_0PgN?Rtm!JC+0kFH"0Z>($]f(
+Gat%#9on$e&A at sB#j at sg@*OQC77eqKfJG&(+t\o-kbTm5=f0b^*iq#Y@:.b=b]P$&0EfGr]d."6deA25a]t\L7VV'ArPaNQ+TJhSE*KK:dsYL"P'@ru8lE5b.:h>7%$md#F6ql^)->CR]@$ufq>HP1d#^P%Lh)"aDI,BnrU>@7r/$7Zh`f:W<`I)5][Z]mBrmn-f,9&qJOTV'5po?0)^lE#Z50i';?'h;+Y(cd>B<2NbFAB:PR?:nT<^#_Gt&f,n^&b::XTZHEmZ6#>nRY4fJ&kSPk>7qArgh]]lW'n4kobHl:S\-50)"1]o)->2OJ#lmfk0P]b*kVYmO5)\2Ep-UdCU^W<]^PT3HdWgpc-tEf at WYQq\D>k%oYOO]K*J/a492?RIP*bGs,MM(WdR^odaP1'T!(&[J1*dD35D[\gEUd,b=nQS6V3X7(Kb"pog]t`$r.Jg,m]FB6$1GVCp+'mG9S at -*hS7=nn!,cS:r at 8;oGV"5hR^5?$MKA4cRoCrJ%fEVAc!#9E9o!ZOfZS\L=^tFK-;6e_P<@s6:5Pl4YCb/iLmo=c-;WX'n]+b.kD[A?0=APk8:R!V]3kfQZ3r-D`,#4m(a4CkZ`oHJlF.ifj>p1m^DR?PNT!Ei>dg#Nas_ilue^OAQ]dY+'1h;2Fo'Vqqn"'IC!^=,hHOp&~>
 endstream
 endobj
 212 0 obj
@@ -1316,10 +1316,10 @@
 >>
 endobj
 213 0 obj
-<< /Length 603 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 571 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gat$uh/Ac:&:`lHYkga;jbeKcJ4Q`j9'O57-;EU(RAL,R$n6mr_US"WT,e2j6C(@X5V)lW'ZF&oY^^.V+W[FJ at -W8f9!LY>Xij/4X1HN]Hoj/HS]DC2CN]/PV"ILW=aQ.+X>5HJ_J2s5Cn&b#YKMLOc2,bKgM?\5m=9ug0&i]5Oh-phqPA\U6cFb+oVTh-qMW&Qu>Eri=^#t5o_6ADU5--+og]b/2]m(OGZ*B0tm(G;1hYs&)f!BMeeq%+lRMbM*G9;$Rbh`Vlp0\05'f_YQ.:d/Ir1CbA:tI8l%;K
+Gat$u9i'Ou&A at 7.=IaPsG-F./LfZ&=8B[]^8enn%W`l_%2A.8HP,doQYFT2_6uc at +0(sPP]f0o)ONKO5O,'+\%J>RuCHeZO>)@oT at GcIf$E&7d':Wj]m\>lEC-PAK]sIpZc6m]YdSGcL4<]SN6)]6TmLUBa!q!;P,R3A;jti/O8;=^S8qXUhhb$,s^]TMhn_7k*olTU;PTXU',61O*YeuKPB at YfS;hm%["W(J;7F?/TtR(\CR7:$*r2CBCk9ILa%mQ2:X._oX,W1r1tkpS0f#C7&W<1WoL at r$2OOle%ApNb4nJOd:eV`keQ>)DP+egD]^=U[meb`KDfoWkQ_,Gc6[;4jLP
 endstream
 endobj
 214 0 obj
@@ -1331,10 +1331,10 @@
 >>
 endobj
 215 0 obj
-<< /Length 1998 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 2102 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-GauHL95iiK&AI=/(ccjX0j!g6Na"?U(5jg!\u3+E7]%APA^QbkHdc?ZTh(#-=jdL;'EJ9\R.KBX5)qhpmlil0)_W=*ic"PdS[3UPF#OU,\Jm2YM&Wso-uheHKU_pSo>gP`d?O;sqel#gB)e(J)@%OFUJ9eq`-#@noui%HQ]bYIh at EE0`c[(^bm\Wq-Q/',OXT^aeF-1/T14\,<[*?U'?7IS6,B7c&'!YS2Xfp)Pe9I:_9r+:M:XONqfk;.:2_\1;*r,B[4VE_ii5\pNPI1,V_](LF2a*o<[IEY,u]8[&0I-=atb9Qie*l!6lmM;U at iNF:uK-gqi_0G]OBnp]j`DZ;rYE?/Z.PP-;s4cauO<8,.a)Bq52:\9O2.[f at B2%\N!EQ[YQE!+G?TkMY,q"fYXQJ9jq*ZY&*nX=D,LrG,MZXec,*4O*-6>d'dY6k%VO^?S4HLhN1>)WUrWb6tF57TLG+:5hCZj]E)r!bIoO7a1u;o54mO4b'p:'D&6FVg3k]:sEK"8Xl\mW+Y7.iJRC`F+GG[6l'PRcBA]&<:?OZNmS!!iu4;_++[sJ#EVpC)GF0nCtNgq8VWWrtk^Qkq2TD'=oMee=r.p2LfVu)XCL9M,lPZ+D0G)5V>"`l7aYqsW)-Z`?VLV;?+DD_ZMe/UIo#].a'YMn.YG-]`G=ibK at d+FRoKh?+rO&VO_Is3<)*]!jN,QX,gY=1f_nR,Ir.;=OIaI8e6F+HY*C1-OAT(lD\QQc%1)eWa:?h;e*/3iMVMm%BJHg.t?=@p!ri0;2erl6\khZ%B_%hA':]F"hQhWpmJ`K.7^CK#\!t6d(IiI;N9,V:8HRB4BX2&`eoRqPea at c"6WQ0WRhG at 1>F?#4h-#L*rm:R"/,p74WVnPTNoo(-(#JmtL7KRp^X#0U$MUr"jn6<9(Wo+GI)Tkc-/a[f8("2sfRZ-Ym7QO>RJr8)_Xo8pL+WVe$&,GQ6fL!AnO(%#=V2#!8H1P7JUi,ml+1AM?^'B+FZW(i at fPNmpAQKpmr7_jZGs$VfrU;=L_T)bOZ/L"38uQ!k(Gl`>0F5k6V`5$YTT at j_$i[Vsb=+B^bmrL/R,2B_ERi_m[1jp4DEY.79!GpDNo23EKGQ-BjRZ%c8;[M,XKb6j^p)9%>teAha2OTRQ,lNo9Tb)X$:O`hm93lr07[[U'?*1OmM!-81EKZ_/9'^,\!FkqKgA)/7SY4G,AD&ANZfDmue(OC`"a2A>s\t1)2B at L!`-U`e6Xqqb$%23T3?34^RXqR"4&L3'-Y\N:fJnlet:_67I,9 at Vu_\VN8Wpk`W6@[r/1+GdG6V3&VlrXVjp7'+T,UTK^n^=5!mA?jiMQLg50t`C,(#7([k1KNKo/G;i#P-pSmVhdG]0DE;E1o2orRug&_`%>H06\N4du at 3ir7QM)+(60kITu;5&??*7`0gQ at 7EN7@~>
+GauHM997gc&AIV:0_SBl=>P7f2Q%nc!\&^*D;A.H"4sDO6=eK?-p-k#mnfguTe%_K9:ZBY-H^IU, at jB9,t*u9>YJ!Zn2?^`p3^D?.-mFF*<8X_2n+="Vhl`FMh9Un^u2LF=E,n&TTSl4&/q1/S[0-Eh#C9BdmSj!T'nMNh$&2-daSq;P[Wt:MnMrh[T\$G'PJgf4$'QJ:q(#Mp2FtS_?Bu(J;8hR8)N[)Bf73"`WajH)"+Q9aYhc,D`=D_0C]20GUcb[,tG1&XHK4[hn]4Ts!asmdtqUMe(`fYg)SjBqE2sY*9&PG!_bPFLL+p=+35UK=>4OL0?A>XmGE2Z)8QuHl-m=&D+mb!!=?RHDPGb)Xpo)8fqApq8"fQO*bc'r^S_b:@IT\LiGnBJ89h'Fo5O!Y4'2n/R13%N>E5AFhR(p>2YSop:\\s$n-i)bgV3a at X:fZ12^11M7*pC!33[q">Q5"l"K3RCZq=_/2j#MQ%AWH6i.X0M##,\AHX#jWt5$h9>ue0Xcj5((E$6eb-JJN7FF0'ZtWAWs#(k*\@AVr6kkIpMHdebGcK(r[D>(]1Achc79sP&]9o?J2g),UHUaqS#u!7]Pl4DI,JTUF)s#ht(`/Yg)_jC.<'r5R?"[V/GTu;sQOS,-Rfj$K&\>M.*LY#FEWtV3e@,GkTiPFQi]@dJ_h)#6Aqh1aFniXg`ODc0<=4-Gr\M#3YPB3dE>6s5!.Yt&bclgNiofT/eXD'0kYJ?^(a%6`iE#i[o9a^RCN`B$*4Vu>adXRYB7ggH_Y&jg3eI=1iS-6r-^Ut:'SaT:AS%)bm"_6$T7QETu-gVkb99JcFHT(79=P!doK6I5:c`1tXX)Nk8hQEh0YVRnYQ5?-kF*/Od<$iSB$JFge2&Gl*0J:b6Fg/&u90hPZl*kO`'qc2 at GUgV58>>0I6Jf[4sA:u9LCAd\`nj,F;->#D)E@/344=0)7'[;q'p$'6B7)g/sEd%T:#O!-"6MiM+KD$/9&Y+*k]lXHp8osJ7^++I>9$sR^;I22%TIg8s3^s_K"b@>@U^sDO-GJ\i'!LSm][og)H?S0Eu-4jIs(GUM<$]ZmP8<#XWgq'iM'gc'D63Xk9e at C67lhVOuF`J*VRdFC(e`%/2jKefLmq>O:g-^&,#TDbM>f:@=VL/FE7$I2O8,Wa1Q-X8ZIqoCl2~>
 endstream
 endobj
 216 0 obj
@@ -1346,10 +1346,10 @@
 >>
 endobj
 217 0 obj
-<< /Length 276 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 343 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-GarW44`A1k&;GE/MAs[!_fd#L0I"o<982F9\e*OlO at Y$2l//]#O at 5hj/bef#H1,WhanEUPUI`4I6D5_7BFG*hkh&k!ULIVLE8$g at O$7*99:FqHXL`RoU!J/NDRo4fC[*g=R\m2'=d;&2/4Bd#?p>G4R2i$]W6<uc?*:?qs7+ZCR\MS^leV5AaaH:5-]SfJ9+ZS5NEL5YacYr=6d#3J':rur4Dq-O7]&Y-YB]rk\=[oX'NhHr-Y,MGS
+GarWu9i&YL(^KOlT7Z*JdJLe+Ku"`Ot\;[S;![]$nD[c"+8eOS$Vc0W;6/4G&7GG,k5-<2sBK%_pM8fEF!2pI"g,2K]Y&Vb*(^-:Zu-^S%i(d6H"B2l*oL*G'^0cbW8t*PXS7p(bX!r1)KiUUn("&(s)>EgU9K at LCO!6r\?bL$&W68;o4SMpiVAeh+uu;kl3G]s#6'fGbSH,m;Me)!3*fS;%51K5KsdIdL_+=WoL-^TBnTkp>7:]_uC6H/4ego2Ru:SC"JV=t)(qa=$3g'b-5@~>
 endstream
 endobj
 218 0 obj
@@ -1361,10 +1361,10 @@
 >>
 endobj
 219 0 obj
-<< /Length 715 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 726 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gat%!9okbt&A at ZcI,$m'od at 0Y?"pcB%olW/>-sWr#>.[APX&tW]DM&4 at M3,m+fel7ah2mTj#=kS&q0OA!L=:J,``L=7i3BC_Z1A2Mumui6k#5!pj)TshJJY(S+f'c"+%$H5(O:^fS9LWe&&X]XT3/s4FZqa.JR\j4U)ru at f$-sVrY:-;8t]:r(FiL[i?d;<]"VA6+ZPZ*@O.jeS^M^Ac=iKTOSfIBp27GW+L;3%X8Rp,Aa`A'1j!n.r]7m\ZE4DEAR`*DYNJcZNjcH1b#=)*b;(WmitI,6fUUh#nddoO%e!I[d/\DC]/l5%_YG<3"]pbL]E0Ah;bmjNiNsde8atq?c+W+u[_UR7)Q&kL+i,)2?oUH$`$KA2MB&+44"BFEDka:APuV.DkIUV3#iCJt\e,5H1Ks[f~>
+Gat%!995Pr&AI`dI,$m'p"OG!V;4$m<,JIH;(lbsPaDS&J^g'1pYXS1#T,mA'e/^4k*p;G4N>4-J6[3*dpRMjU88k&92/&033Q%I0ti']h`V8GFZI=5"Il^sCqigAEM'K]+iRN-*Ch9<4m#d\f2+haK1Q-jC-nN[VkiITIr*E1Ga*]-Pn6lM+r0=OGeWCG+W$(%?,s%ZRncHdgjMq't"(u(oB#9<+873"(9ljU7B58(R.8"*(3, at .o@^6?P++V[;[R30Uu2i+8N)"_P&6U&V(.\Fl+pmNroWpj#2V09T8cXCR0en(k]C0laLneG>.ol40r1:p]]XOJ`W(Y;.bTcsH;/lL,Q&p\s@!.P$?"aG'C2H],tF$m.5uCtkgpIq/:s81GmN.apuO]"Xe"MmEkpBfZ7i=F(46E0j/J_[OC#?\Gq$VT+Vg)]X at s%eIf[5@]hA~>
 endstream
 endobj
 220 0 obj
@@ -1376,10 +1376,10 @@
 >>
 endobj
 221 0 obj
-<< /Length 712 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 733 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gatm9ac=h8&A at rkqD]^^VYB0PdL:d26A*We>S%.$dnVH>$+9r"^Sa6N'+U`V((K#]IUuDC7m:(q-+9q^*?KF/.la*sST)`&J&Fcr-%W at o3FEQGZIeR+6+,Kd[NN\oX+VB+6d[:0$2kEK9+1K\ZG at V=2SHa9`3UW2qXEg)j?nZ!cfLQlaBShDCXd<9aq?EB9&%'a/#%qT1P;'l?1Xo5\75KDntrh=3Wrg5SKf9+6J:]V;?dk''YnB8L5h92!jaK;/i1U
+Gatm9bDt%*']%q&]UY+_n_;=jU_tQg"G9/WYlPW.e7g/h;3DWjIub8Tc)YPD6J^;^4nmaP\Ms86p\Fsq=@/`I&:4\!4UdGJ at 3>kE5klS1q'1e7,0ETL]EmkK;*9PLMB0W[V.2b2`fZCgCIoe?M^;X^d,`/#9b4S7KTR#L5c0]o\JFBK_c0o2gtek!*oK6^V?Z&\*a;(YaTLlgB=?h0d.MQBm;,ho6.RF8=e at .gNIP?lU8=+&(6X4"=rd^4hI>5*t2SJC8V0/B=;SsDd6NZRVAkMpT/k*ZUdCEJF=0=)9[+VAUeY?rL0Na8"^W1T7L?q[aA!YG]I,,ZTc"7N/dBXW)IF3'?"R^3;=PT%KsUN[f=%>@[&7D#nQ&T3o9JBY8Rfhq_L=&6_a~>
 endstream
 endobj
 222 0 obj
@@ -1391,10 +1391,10 @@
 >>
 endobj
 223 0 obj
-<< /Length 648 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 666 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gat$ua_oie&A at B[G]\J)j\G*.+O6Z/=qhQp$$oEYb#P+R($QqAqbe2>C at P?g_P(T(4jL^.LEu`o6ig="JL$9ffL-Q!pL/RYEgIDY8>H5W"^Vu%dRrDJ?Qf1(U,]reNuCLo7:8gcJ at sEYR2O`pp#Z`8$1AiLb at NXt3KIQJ\n]rIY]iR?KCq;#j-)f*B0noB1DDrq$Cm`aiWOUcTi?"Rqn0+LqL4B\k:[TViHVG/NS"CsN+Sc:M.u2@/3-X*.GBR5\!p["CMUNH8-rd_KER4??B6agVWCRB9:UBMbb.et1oD!mQXh"VJ$r.>*lTCWSBF+8UGc7ZCi.SLSY3Pd:a at 1JWj!#R;-r,92T?H7jkqI;b9fmL6$<1,;r(RW&1&K.A5".^lG'p<9A@[D0Rj.`q)e`fnDEPN2GH,[+')6U9AMJ^e]<+V]HJ98n<9m"2uj^@[-VXBCp<9p_0g\`bViSP\Lsu2AU[RY;%*cMI`dPU*\2Auk;os3C?);Q&CHR#eC==1Cs!WS&bem\+R."D$sJ)qR_&.d5EQP0>l*9^HI)4LhJ"tSIkL(?4nS at r$+H9F/eL#$g9~>
+Gat$ubAQ&g&A7-B_lgS3Q\JMlCMA+cB()59Wf';A*#9m[<=_<>`lSgXOHf>:CI]V\5/W6h4$A"'gM#apo at 0:O^FYim6+a4dCD,:6aF#j!ds5V1!Q_?V>U$RfHC*.!XVVNGp0Gq=beP^1\$PjF=rt%r9i'Y$:'bB^?Ij1+n at bDBkl-i->q:^[%P_&`"n/h?g1"uYVS6b)-6/P[*pE"P]0ML/`4+YAK$dgj]Pi`XT$,5I>*_mKg
 endstream
 endobj
 224 0 obj
@@ -1406,10 +1406,10 @@
 >>
 endobj
 225 0 obj
-<< /Length 1036 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 1061 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gat%">Aoub'RnB35^c8$iF-PDl!(01d\a%men?_[*ZSW%<%o2W[aDJ^5(b":"HlHkfZ/B[kP?4V04u at k,7=^kZ'Oq(Z*lH%3V%ell;gRWXRj]qmhME*'EZgX37"M]$tI7FSf,R/Iq;(%(ciF%3\2JJ"cH"6)&5_2;j/HdK!B>-q+9_c4p!LG]c^SJ at fjaYlC&tA8Tr11$LmO[Z[HSmbQtC%PUlQ]GTAe^=DZ"mO&U9a5$Z?N[S/CSHD>&6X[G$bp;[988JaZ$_XOLJ<>,kkke!d'h'p",M at d2j]7Pm>i'#ZB)Fhc2)\>U;VI,VIO>>X6n:_lP/?'T@kMhJ63p-FW-6Ed#q4R,WR)f%g]->1>`4?&;QHW#`jEQ^Khg\)J:BZHh`>9*?+*i.P#K5aL%+Ws$?AV52^)95\GBQ,]/[:1?#U,K:@=CKg04JoeB\t3ZkW$S41cLhMQ4[9(s^-IhjlVH`"3+e:$0 at F(Li2D(E4QW)=e#!\g^a1RGd9OTo%tsW/WM-]Kmn"&ihpm:j!MPMr,1^]m:&C8A-_d at .60J6bEqW^#>Ldd06U9^#W7R&7(!MPJhe)W+iK##aB_9%oYE/jUk7k`!Pefmtrt!^IV^;~>
+Gat%"995Pr&AI=/TU`;cj5Ll9]k,`re>cfRh5H[;#D\ZL/WUUimRC4VHOY_^&-uK[Ym5d=q. at X=ICGf]s+i8j!p!MME+W>O)745U6-D^4[N(n at c_8oNZ$n;H=Mf!X?e5([6r=?GEe+A$!/N+Wj!!>iW":VE3%T\KjAEM'Z'L2H.i'(W>Wo]WdTrQE9Fk)$&teeQa>jo]B,HkCE/r$\Mog[gZ^[>rZ67K=&;, at s3$uFlNe0Bb;Sc\c)#nUqa/^mP!mj5#e/K[?8"e@%!8 at s)Zd:.Bm$arCDf2rDcSjOKr_E$WKZ\>Fb4-t=QO-GVSSm$_5(uC:4Pb/B5?M1]ibH\[<[gGPZ*A?*B0+B\.NT81d^:W$aYo':g9[U(1ZH2'$?,jeoQ\P4=p at Za+[4Cq]obqm at rV5V'h"?jr.cW6no[WYAUQ6kllX<6-cV]]eI*<3qC=X))sB0R\g-U_fuo&n-&7Ggog0MA^r'5:J8_n46HmFAg8m7XH?\Grt?jD0+@AV4B=lTM1n0Ym+nfL#$X53~>
 endstream
 endobj
 226 0 obj
@@ -1421,10 +1421,10 @@
 >>
 endobj
 227 0 obj
-<< /Length 175 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 1000 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gas3+]aDVA&-Up?T41DE>^,YW>TM2.64gR=.nO1W,K>8;mqF%*,23Mf_cIa.2\@MjYaP\(.3tNPh
+Gat%">AqtE'RoMSa:m8QC4&V>j8l&n$u'BKJd$B!*k^!:,>r/60!,'oVb(VbCRS"HWDEG_lZ\B8ANG20JHUc0*!^1AK>DS_!bd$2?l6\0-4u&J'Vt'Qa4VJ?Mt>k.OFB$b-pZ-a0VBJ;E$M#1#)o2jO]CtU:jS_6C-Bln-&SOhf3/o0Gok1Le,[dC at a+3'WeJr'_X65UKbY#='iJ*#$6ELX;[91Wp-f'hWaht>=qY"3=IrNFRa4tJ!%&+V4AV;L_Lp`TX[G7j;Cl,tF80Sb:$Hn-Irl3- at W/p(T=4km\.?;O/4H2*9'0O3>9Tg'Zi(ZSF?=R?'.5+q"\h]7*-\MMb,Y@>:eWEkBJ(?uK%DWSDal=Qqs4gHepsNeM/O[lCV=oU34lOr5Tm3[)P!l!X\4$nQ&<.D`?U=I_\pP$"jH%6M]Q(Z$j5TX[eZ6WKD'94+'QI-F<''l?[HK_n9;fN.dVBhr*cP]AVL,V^RBe9Ht*j%?[og#l&3+e"cAM%'P\Kegj*+g:QXV1fF[H@>-;5dY?V&okQ%XRsul%]9[5[Hpp!TP:acq/5/Rm>dYGl46U)tekM&@&`Fs'F3C.NW_0aiS[XKZq(l at 12uWoL?s?X2?*qS-kY(p*CX_E#'5WI+=+t]&YqBoWjDPX.(%u\TGPKR%@=4U%\>9KUM$98\-dS=:"@5]ZtS\l$>+33+2g(I_DeXQo9n;!r=9iB1;SKnABG'C.QT_UbB$2&qF]*Lg<5V@`JsbHD^-=^#=ru3cL=NNl(.n$eOY0:V-i"m]e/AOm/V&^L:fK7$,_YcS!]*72c5JnD:l&S&l at 4'SN%-#[3Gl!JPEq6N~>
 endstream
 endobj
 228 0 obj
@@ -1436,10 +1436,10 @@
 >>
 endobj
 229 0 obj
-<< /Length 988 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 652 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gat%"95iQ=%)1n+pb]@nXQa08nmMXSXog^!"h&a3 at G!k?jM[E1GIH9Ys*f"T7$dDJMZA;rlQ[kL,H:!Np?iS#&-jm[ZPa1;1DE+G6NP'N#\-C+N`hIHK:`qj at P'6c?U=PATP/j`LN3ucA!#UY0JCt7XE9h0jZ:W.9'/b]f"0#SnhLJ*D9lRBTj?PtJD*VK?1nW,^t4f$>olGkkOl.l"8tqVmhqSVI3/V*(g'JaOZ3mT@\.\A*]H]LIsY.8(d$4.:%._,Hd^#8-5Y*CQL8D'7^5Q5dFdUg!&Kh5dD$67o6\Y(W+!n9NgfQifs-U[LGB!Ue7#J!T_>-3oa/";"*be5`nmel$WAM.;XcOMrR(C>fN6MkZ@,fiW*V8"9V`q=.RXA32-ja'OaG'hn+O798G$-Y$Hk1$QgpBh1c':m*)OOP#,cbhTo*61t?^iLW;%AEiN/g&b?%i7()*U+*H"bj,kE-==`#?6:FbClnSGd3tP%:@C0aF_jqcRB,c7g\q)=/.mO8ocWjkW5RK at f:[U&qHbJeHmKS-#\.b]f6Y#A:NC(RD])6m2!@=&<0i4Paq\NB=Ls[1H']0p&ajh(Cb'mIbL736WB;&BOs%OXEue$%gb46b^kfUQ+"QU37ot[tl\SZ6A!ZmjereMNHfE5fEVT,fM4O"un`K7WTNhr?4di=P2SSm2;TR'LND\1i2tDZEBAm]nagnQE",Jr=&`(.p8gUCf`Y8H*C#;7cQD?HtT/P`,Z"`1XFd>nAJ>p6mFSfu/[kn\NC]#p=NG(P8h]KfSE#9UAELY8QFRS8X>o]8mDCVYl6aNe'ONkM`Y#G at nREXaU\UAJ+>q.Ol+mSkE;/>_ej[lt*~>
+GauHIbDr&G']&?q?Ht+]qYaO';Pm/)ejGE"MHR\!o%uhV<])+T1:s*+7hI*9[O at UbW3ETVT(``&@L0no at U]7:L>%DR2c/k%V9;"Ui0tpRCW)aEIMX^C6tRAijmkSM+W+,jE65;GRd,:"X5[#a9Q`-`OS-!3Z76rM_Z]bBHRi+XGgK2(d4/sWkok[YopCKnh_1Xn8M)E7 at n,l)JbPjd)3MEkPYXuY+CStT8>p0jb$L`4]42jA\L=o:"Ifp8uOa^Y#0H%8J;n-BUFYqVSR^*.m5KE#!\2Sc(+$0s.p9<;YqmG[mji2C+rCP21.o"3KEgKWf_M[;7.sCm?`9!6uEC*,'o6'tNjrH5EIAP at SWf#N&=pLZh+7[CQ/1%@3[l6S?2k=*"SoKue'U<5YA3>!0E--&MXKu'tTT2YVYc67DNWRf.mEW_K_CN(("*JP/eq;$IA6tP]
 endstream
 endobj
 230 0 obj
@@ -1451,10 +1451,10 @@
 >>
 endobj
 231 0 obj
-<< /Length 633 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 901 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-GauHI9lHLd&A at Zcp6Zheme=bqQ(6Dg<,JH].$pq=CbH9`%4U3nrqFCu3gbt;EiHQ"_n>_eB&Bh:;=N]m6UV#G;%d9D%1'iD6P,s$%Os#[.Z'l_qL8#nhV29,"%AhsPX#@5<#6]8"[a;JIGfe=S"On52&cg33".Y)3kIG61'hUnoif;12+ at pZ','a?6PB_f
+Gau0B997OU&AIm?pk3f:C>r=]+G&#Wb5l=>cphsS%W:Pg at FKJCKAH+aE?;6QVJ4t=HLX\lS&[JJEGiY4X7l`>%^?"B]^W^[JUhB^#]L28i!0YtT7Lqd^0Z5P4*;"HKCFLZ0n;Ar?pFqs_MuDK(ik3hKZl1la\"-p?)Vk70?^@doBeD;@b)B'ID_FVC"8]><`M?+86O at 8Z%6D*-o7@#19>k*pr"=_;e4):KjR*G'sN:+pY'3M+U/9M2A6TVIXQZE@/.qH:k6V9%"b>.[G3X=iISA5?;UARN+*""3;<"-5BjcJI".<5TB)`U7;jrU/iqL\jJFkZBaM9OF$E_>!!KFI[a';=uH_m]E;3ZkheT\$PMY+/GF[#\3Zt+NjT?R?)"<8,"C8[!'A!#n8gRQ$ZEM6VU\n`u_cb_V:_Q]3C_f2$;XK.ZC_6G,X_QPQk:=TkJ-6slE#UEYG$dV=*G9!_!8=#-F".l[(S;I%iMiMHc/(EmGFXok`\JXa4t=H.j<%a?2TP~>
 endstream
 endobj
 232 0 obj
@@ -1466,10 +1466,10 @@
 >>
 endobj
 233 0 obj
-<< /Length 882 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 198 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gau0B997OU&AIm?pk3f:C>u^^"OaGT%S._9NSo=H\>dr19p6k6G0@)0H*hbCk8mGQ1Xhcfk3^rYZSrs45S=8DN+W/nbn(0I%fq=c.hi#:=E"hS_2kWMH>Th$:Cqu\L`7;:1M5-O6,bu`M)N`iE024lu,Al,Y#W-ZsUENJim(d4%khEAI\"qIn5ioB6MHp`ns=;+!qJLh+Z6E8ner?e`@o?Ktq=,+0fAkLc\d`\:\Yig]_4S;UKJ'Bgn*_T*rd at g0t_/*q-GgI2'aX`9^Q7(\2$r;;aH[cl&8BBGVoAV5TX$0"X^*;>]KM;trfQR:9X<]e-i[QfdhMfj-gLeuq&N.MC4j?P!F2h2D*HXaW%lEW.J*P9na6fn99G[WcOBjR:W9@;4)bAqu5qQb/.!d_KG`]Qk8H)`/_:2LMK/P;.(ft4+L"fOMVB5aO)T9;$'*1LX1mP_WCC7>#%)AT\CFueLbCJAY&P))
+GarW2]aDVA&;9q/MQ%j:?M8jAma;;5+Z at 2[@\I6VKb:)o^Sa at cO_n]CLRkVD<&PN3W>I3b98k*0E#oJ+7VNA%O]<,"l%F3,h#%&P487>UAgW1Yi6%g^I':_22f+9;OAd*o"jI]d`nuLc,D[b!HYLc?32!)_e`f$VS[*`dAL#Pt4#=Ws/aI5/="]H5 at R'MrK>KA`~>
 endstream
 endobj
 234 0 obj
@@ -1481,10 +1481,10 @@
 >>
 endobj
 235 0 obj
-<< /Length 198 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 1417 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-GarW2]aDVA&;9q/MQ%j:DYF'MQSr4YYn=,P$^E!50OiQ+pG@[SZH_b&Yk(kWo%H?5%`'9r,j7cbdO8eVXMgk>_I[\B-Z$-c4reM>H+;/)d,([QPQeAGpU]c'j*p?aPhI:`BGp%irRSgeD\Y at dQ^4Ge"ta\jMSI!EZMC!5CBsO>'D%^FLe
+Gat%#95iiK&AJ$C#[U-qnFm1d-N7N;p$RjUG'(;Kha"Y^*.$Wbe%$oSJ1K^+1UMEi"(3SMen-G at LlZ'"+f.$L:'aZ;:&!\co]jr$`-SqnS\9gtN]b at M=[(A!NieBb>jBW5:L51Ika:?@$cXP$jd%q?#eT(WL5pu\fUNU1UZ;ikK+/&fceU]2P26+c-h/Nqf)+V6#`CWlO`aPs2;K2NWH#UI6GOM%o2TNctmfk?=\[$#5SBZ^mPNh2s>\un*LPp4TBfTao+Y4sB5\REA6G/M9H(JZb#a$:F0X:@4-A!5_BS<'P:5Pc^TDo_,G&%Jl`SY5sST,H*OVirFa4j5o[WcHZO?J-jQ0r^8A(eA6HDaZ^OM;)']Y'-uC>4`=#QJ_nk$5iO>=!+D/7%oYd=4\RjVJoY%%/]WOp:l>/H0QWJOb*UE"*[.k]0BV9(HYI8NQ:'fea.u'IOo at gb9/oFNi^L5JRK]\*&[Dn2'$\)R"_b%X17thIQK5YSW)lLX-5*l>Q-,Ejo!#B>f528k"H>dog`1gLKb`G+S)8[1-P+8Y;b&Eb*GCHSY*s9o=)o83AHH?^i8#$@9q*P36=IX7D=KMD_51##TTp)a,)J1,g_K3U-(JrbQ7\dG>,,RSQaZum8d3,D/XaU!`oW;#U]W3XOmE-MNYn!-$7+M+8(97q>12&1?9%53WKqGK#RmY;7:gK$jNrBF!3&o$GU;/Q]\@uAB9?/5?eM>Mpo"Z?fq0?Ys+`U.BB7!_TuC(.rKG[sO>$f/-Yc3e`=M:L[R)8UYYb<5$iJAODPd(C$`EYC%e3g-hqTf7LEj"Xq)SPeCkfjck at Pl#!8\>=[4;]aiSMe"BnBZ1thtDG4M>;Wd\t[bMGZM,X'`@h=[&qYpPAm?oO~>
 endstream
 endobj
 236 0 obj
@@ -1496,10 +1496,10 @@
 >>
 endobj
 237 0 obj
-<< /Length 1375 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 173 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gasap=c_;q&:XAW&5o1j(2Hr5FR at fef`EUS!,[_0e4$'r. at XG-E_(Kis8,\<,uTL/k_1hP2o?NY`K0?(YJ9#rVB?;ujWY+V$Q+QnK)nB6AgUph:_F$!6h&FmCOVoe_8!h_GE%I](`Lm8&Z5nFa8iZU>a6[C-s#qp@"k=e_fE/*lVFmdE^?P^jDNX:JQ4a/'Z1<9lj7[)pE_ej3?s8$8Mc"tlc`B.UISlo]@)EGAZ>A+\Y9Uh'.Aad0pK.B>fEDARKf]F]"d0[$aYkZq`@02*FB*#h\!0Nb&[6M_3Bc!#oqW^$uXL_;G$H.lO8bHA85E1HbHG5cioAR*[4Bcl92lE=\-?h"[].T4*FM9GoogW4*+J,^I_nPhHW\3*g\$a_*[VZBk##Jt7k[I3$L]A+ueURPqjiVj'5nh23e&M0K'ft6KA(bVI;q)EY`EOR%+3J@@RD4$oS=b4B>R3rb\Pq5=F3jfYeA8`aGO#H]9QPh at dWNK$TT3pea*GJt^1YFAOfmR[H=PZkV(20gEcKqu30s5V:O-'/CE:='giE&:_mWN>L)XV<9Uo7Tje)2"M$`HY>[(FGAGKPi2q]0gAl?KKm"BX_K^SfK;:bT'O;QnA1csj8H'W*e[=l!M<%7;!q<7coo4JQq][S[KG%b#[o8(=&aRkiUYjgnjB%nhe'86R&iBr]n5Vq#CdqBYfSbp%SZ*gV*C8#XU?W"LPHZ-nUE5sYf8Hbb91"nih=U90j9V.S_EJu$U1$X;@7dWj^iL]Y7$j)*U;=j?'Djm]=2Gb>lP^inV?&4Qu$?kS1YbPr?9@\-7&*'_,W"DB0O at HpNc"OoL/:VZXdn.jf4&38c@\8S'__b_>1Tr%)8)gTd=]+WQ:Q2>W@!`YpN$,RE-U6&akW<#VP8#8fZ7cnt-\di]93K\0?0uQ"9LO!`f`"e?]:oc"hF+#b*'Lcgkie_e'VATu[D<-2WToiCigY4,RKk0j5e".E*U8o_6+Qc#nSp_K(_^0ak4\Hg15*noN<-;P68GJ0Il>2uao~>
+Gas3+0aki`$jGQP^ETE_`oMG[D_BPU5nL>YPMV-`Y:0)DHWmD,8gnsm(o:?Zp4*+!fL^Ee%g<@)MjFW\/R)*i;X7XK2nN,agDXFG"b>p0je!g3T<;fEbHo!EN~>
 endstream
 endobj
 238 0 obj
@@ -1511,10 +1511,10 @@
 >>
 endobj
 239 0 obj
-<< /Length 235 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 1791 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gas3-]aDV1&-1WO:N9l+oXm"PPHKU#3!`tOE@<]0K!tZci8^;qU'MsP*;B'\'p^G;!`D?:19_343&2!)K*1jZ!_i_fjC$<,D0%V%@RmP4(EXurb8:\u43"uC,C8/]3ch`73.9$=BrJT+_3<$5O.q<[7:@2i8"\!J"nWDS,m+P-WV\0bq0Y+C+
+Gat\k;@\P]a5+Nmp[foHGTm7V]9s9Itfb[_mo5o[,=8oE;&`bu]&th2mSGgk2qrUh'UpnW6cMjT7$68ET"-R=C^naJR0gUqW'h-6nHroflZDVG=Z9sg6Vd!e(K)XiU,9`2#*opI4^sjnm","sjcm2;l-;9(iltTtcG?*3L?;4BaEEd/'7j/?We`Tl]VV`bijSYm"\B-$&LLa%pblPFh/3Gk]ZRApIX23Z)clJAMnI%JtkfE at u"M:D/CYlG"HI4eHK9mcJg*QH5pFEVCKDIe[?jF(kqNERL0&cMAh!cl]Us:RNtf+a.!;\l5/<)&WaC*SYb7<`<"Ri#"T23E'Jh]=]u_3Dq*UK%ap9!%_^[q:R+Hm\un\rRh(2^\'Ib#Qo](0=\B\QSPpshSXiL'u(!:(E%_3lHn.(D_mN`tc$ej-JaMeHZ68t4UJ]&G2BW$_Hie*/aoeiB#JEM+#iZunaN1#@cXA4o2Z\Q-':&V^mqBT.&JY5O*34VAlrA",_`FE=K8$3gP-JjI*ZV?.%ZMBF--drEZW0V=?RQ7BJOS6`)54p1Og01<,_]!07l7D]#pp+$\mP'ur="Pn$Zn&HgdCoKUHGhDMJ+,4DBki,PpO!7YOFu]IO'j8FhlS5g@*[GdOM.9m):2dcJ,HTdIC'dLi6GSJ\0R'fmkk]Ek54o[#l^"=i'o3-L?t(jWM&`08)tE2U-pUI*)$mdcCTIjH*mI#@\Ps5a]Xs/"@1nN9B'%KoIa%df?bc"so3-&(s5Q[u/Me8M5E#nD&/d]d]U?OLY6PgnP\u)#GGO#CWW2U8F.HT$hG,YA;UY#:a`ej7r8 at Kq^;">]*"\@u"THX9_,Jejr4XT?lXaj(;3?a4O^gVGAb1NJcbA(C49sWB;E;9Q3PJX^8)RD7>TsWP^\$:jg/.Yk_r5]7];YJQpuUMN9%Li[T%dDYVRV#JO5f$bYJ.#TC5RENTKj!5rS!O;L-!<(moOH%o7Jf5]Z"sSK2LOdjT+abBnOc;q(IC@^bl~>
 endstream
 endobj
 240 0 obj
@@ -1526,10 +1526,10 @@
 >>
 endobj
 241 0 obj
-<< /Length 1516 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 245 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gat=,D3(GM&H88.JPrJl8f'/CSWd5+GMSIcg7EE8-*X`ZP.Xo/Z42ZLZ1G&0n^D'(cH@',L at hhs/0OZZbG=R4j(QZ$;:Eg[n5jIk.f%!e9-Q<@?(\hB at 0h:>/GHE`]q0+KV#9>,f:-^ig`?NJQ88G!'i"84kDCp`NWd1Z,9A3#%_^N/&E2?Z:ddco;KU;m#'T2&O"]RiGK4aUk27b*X/`6?>3qM at 8soV#D+ViIQo3hni-7U>If9Lc85mCX*V&b"#_ej#7BGd&HR)&/jYdNE*83^"o3:QT_I#mk&iLIN-(J3(HdON>="u-Y at rSQ[AiK2jNoN+YN\r[)Rn5,GF'g6<6)=[(<[=Npl%6N-$k@%56XlH1%4qsO8rFXoK[9#')KHg(!9G\RJZFc<`Y\ka+%[=%Q3GYTHE;-2daVJHl'oXJA^t!f^Tbt8-Dq/0;j9O^_Eh)94j[R(Bq"+O+G.0EpVD$[%jLH*2DDcLCS(.j\,ctiVh7DPG?F;W+nn(8pf1'-K;^OM2eR*N?("tYemI2'a&9+)Wle,tT72VJI%*aD4FaZ88L4.*=7>2\Y,g>4m,'\s3aR6);EW[FH"XGJI4j0">XJ'?)eZkT7l(!7=Ba0G2U!+Y at b8H;ER_>%J*P#j at J/-892JS5!S2'Y=n+,<.bFoOhd+`<2'oYoKhWut%7QE9-uTne[E at em4.Zf1f$KH>O>N_5!DH#cA`L7fLTZ\8=^8fFTV=sXk]Uf[e0m"40TL5B-Ko`U$*_Qb9b1:
+Gas3,4V*,u&-h(+^Z%^"3.%LhiG,*>K8Hk&EBj[pJtRpVrd2hD\eoM3S,7GJk/:dB"#6eY>V7:l"G-26^^;Bl1mhAImL7iXr]"GT[]$76$mANm3&RKTfG*^9mJ=:'G2S\C1dKK]Hh,FDl5DQXa>".\Wie)s:ZbDWL\L`gCQ/O?T;>=X#.[ioRJV6O>#\G8QltqWQ$%D3o")r#;\bS:^.FgWDr,5fs6?j75;O)JBH-qC08.tIZ2~>
 endstream
 endobj
 242 0 obj
@@ -1541,10 +1541,10 @@
 >>
 endobj
 243 0 obj
-<< /Length 243 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 1321 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gas3-bmK%f&-1Yc5/eN5i&(>kY$M8nF9nVS70fkn"Of,YHMc9X,)DW00L+GgC>!tX5nFs6_%r!&A/rYq#O]b4'.\A=BGAPmiK5hX\f#I-#qh#,c\tH`(,+T2?cT5~>
+Gau`S?]Us?&:`$(5[15DPo9lHN6Oqr[+F-!Y,YN>2sO&b#EkIm&qQR(p@@TdK>BGKE[RE"RtnuCq>6ZOGl3$(=M4hY,QL\[SM#-8e85mYe#("nBP\UC'l>,!Xl?l\',4D?Z(gI>u&4A3eV;`UH$aNQ<-da#luc8U!.>eGLh6i=`*tW"d(]k3'\TOJV2$S0d<5"7351:Pa12&_5n#Q(KXaB46]SaWmP)qX+BGoWp7[L@[iV5.Ws2up.[G;/Xl(&95+31g8f*_I%m:@)h?f at giMhfVa[0F/YLUEQqU/'0d)VEf6ga'&cjhNi*UTL=?0'VDNbme+:)q-&.$h5!,:c<'.\9YT:L7CC4K8\:`AUJXW%U=!;ngBV;IT#=^&_:+^2]"ic_OY=X&#ZSNB3ANhWH_a'#0_IG-I8db7H*f&rbYq6n8lnuUJ$79BVXr[4a]OdAF:#1?d;9j8WpUg0iNH_o^(3NDa;2d)]_1o>:5";G5V[i1i&-0glBFZaMBcF4AL2oTCoNM)'P+#`k;P'FR&+1#7mjVbcgS,LXgk$]*9(eP8PWtV1$.93G.>cep,Q'Bg+[`25-]l8Fh#`YgYE`kpqb.fF"8;`O"&Wf&#Hl71k>(*Y8;.rI4M5DBo1MGh%QX=oFO]lW(7nPj:79#>&E%5;D$iSiQ7jk;8Iai8"+Tq?geSA#^V_Y=8F."UjG*),^>6Hu/.'pG&tegpS0%%$3-J/$F75U at +]@=ORV at bVB(9X1I[-2dMN-6_BB%G[<$e[ZC3
 endstream
 endobj
 244 0 obj
@@ -1556,10 +1556,10 @@
 >>
 endobj
 245 0 obj
-<< /Length 1301 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 1048 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-Gau`S>Ar7S'Roe[&2IWdJ=.`Q8X'Qu5eQ+#7B[J"Q=gADLB`&G3OQZ>.$P2,IB8^u`,;I'l17M]j4!Pf$+7Y/JJ]MedHkq"N^%_:"9=j9shETlfGMifkJm0jo,Dpo6pani[MTn76,o>1:SY7*pB/I3X%OHqM8LriMZ)H,)*EP"L+BF.LM#k!A#/(-M6r4lr7219a![ki4IlB^bF^7UJ'7[C_V>-D'F'dI'=srUq5r">P*X2_c^\hj!%r&_h!O"29&IW9qs!YA$Seq&KZAbK1iJ9dAMiCC)/'T$V[L9$IiI6*Y"9hB`_YE^$NsXT/b(_JGgJ8%ZU>Hu:T2!ts'8B'=1/+1rdr<+mZcT`W7%TlJA%+_hC>W-DF]Xg^3]C)"'dNOgDPVqY-FYa:2MG@=@XlJ0\r+p>Pf;`u+n-0*9RGU?).j4J])h,d>O0p)Ss<$TZ%,^U0cCfGL'VBEa0+[2:_k4ha!&1^QEand>2?&(l^edRL1,VPOPb`!G!,;0/]C$7Is$RC&WE9pT%pp1OAU[p"HpMo,."Xg6pn?:1W3:3?1CmsG<1&)>jl4VCj2(8Me9``d\X at b`2jJ\D5,D\A>l$rs2mTCYVY%CE#rSl.^lf#'qWrp+VdWt`5/h[2g6d[ON*&%_Xc2ErW at GN2BVj?eR"4YY[V'9+[lHINL\;&j=@nHh2q'T#uD3rT^T9ln1m0gUUR0PDG5c7]@:e at 8>?8h[7Hb8VdMulC#T"B5u5X=6f5Z+2dG"@VhrrJ["dD#~>
+Gasao;/b2K%"?O+d+btG_Uu.?fmW1t($K'ci6Z;XYjF`!j?tpso%?dDr;2[h4,Vg`1DECU;'Pgm'Ige$c5)HQ_D*<-KU2Eb5jMR/!qR3PL*8f=8V+ki/[sruc$`_%[?A:Bd2XqHBbI3Uh;!XDT2aY9U>V$\l5'=`bOBbX%4)*&;7u_FbLh_0pmT<-7-ueo!NFFo1EpAP"k>Z6+flFMW+mIo=])7<_O'^W2V*b*TGg*C:E#8R\m`%/9Z:ki?a2ZV.CHlo`)`^o9.=U>5q@?2gdiO)q?T8*?B#+&n2;*>ok$7\WcKSh`l^F:M39h0%dgjD?%Ed(?KLmYccEUfYDm.'C;DUlR!^a0P%oDf`fbN!i8MMn)c<#fZ,E-.f$C#MC?:!4h@=JActGSDjgH_#':0r$),T<+.Q5F2N;@uRnp:QRdVM*8'm/,Ri"':ILrF!,*WStISl.Lh@`&.#+>fg5E6:beVg[nG/XUDeB`JDJ59NQ)7B,QKMqtD_h\eGlt>#-uZmIc67[g/Mjd])]h=7c=Ve5\?U+2o(#otthDDtertGqejg6VO(Tfh=5%$'`d8T"S?g2prP;Mu-7(K@%%g$m0d at FWpbeS7PmD~>
 endstream
 endobj
 246 0 obj
@@ -1568,53 +1568,71 @@
 /MediaBox [ 0 0 612 792 ]
 /Resources 3 0 R
 /Contents 245 0 R
+/Annots 247 0 R
 >>
 endobj
 247 0 obj
-<< /Length 182 /Filter [ /ASCII85Decode /FlateDecode ]
- >>
-stream
-Gas3+57>=^&-_S%5/iLBoXrA^FtW":+:-Z=5qseh9ei-phIr`<,.B]&4at)"e]+=;1&;07!sip15uFgubDN)aJ&B052s*@u4JL`Mg;A?-:GX5+dC_9e<-M+LEq+=G6UG??~>
-endstream
+[
+248 0 R
+249 0 R
+250 0 R
+251 0 R
+252 0 R
+253 0 R
+254 0 R
+]
 endobj
 248 0 obj
-<< /Type /Page
-/Parent 1 0 R
-/MediaBox [ 0 0 612 792 ]
-/Resources 3 0 R
-/Contents 247 0 R
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 345.52 637.683 367.18 627.683 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A << /URI (http://uffi.b9.com)
+/S /URI >>
+/H /I
 >>
 endobj
 249 0 obj
-<< /Length 1022 /Filter [ /ASCII85Decode /FlateDecode ]
- >>
-stream
-Gat%"gMYb"%"6H'k\Y1A.)+nSpFU5`TL1GABXV>_qk,ohU=k-qT6uQuUiSEs#]qJW4=!A<2m^om4p1n<;&"Ub3qC(,j9*a+Hp at et!>97F/m[r0Y]XXt0sZs^r;",oP\6;1\N/%+LAKL0.J)&rhM][AjUSkM%V.cfn8]IPTkST_-i.LG!67ZbBgOb)M$[POq9'WoIOG_7O)4rTPVNKo+\ssR!/bc+(CRBr658u89WR^B>"kT*IU!ePIY>58rp1XYdmi'XY+)2NT-BJd?V9=(g/Pkr./B)idjCBe9Y1bhE8c==-MmWJa,OVtj\Ij]n\'cC4Hp=&T#e<'iY\GWjh-a#902.OBjNP9j:+'Rm@=`*(]Q9`]MADLeSS.hNZA46&JmBSrVHaST-#-,K,Ft^G*Hb5HgT6:G'dZIe-=f=iVj0bl#Usm*T:+Ec>](5sOV+mfCO_>Sc$^F2NN2!ik2`;fN,:rLNEEo[Xmp37U32057++iA+EU$4gQUt84T:B2m_Os"MsTPEsJ>/?f)pWI?7lR?2ako:J":~>
-endstream
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 373.595 637.683 444.155 627.683 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A << /URI (http://uffi.b9.com)
+/S /URI >>
+/H /I
+>>
 endobj
 250 0 obj
-<< /Type /Page
-/Parent 1 0 R
-/MediaBox [ 0 0 612 792 ]
-/Resources 3 0 R
-/Contents 249 0 R
-/Annots 251 0 R
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 582.79 626.683 614.47 616.683 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A << /URI (http://www.sourceforge.net/projects/cclan)
+/S /URI >>
+/H /I
 >>
 endobj
 251 0 obj
-[
-252 0 R
-253 0 R
-254 0 R
-]
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 626.66 626.683 641.1 616.683 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A << /URI (http://www.sourceforge.net/projects/cclan)
+/S /URI >>
+/H /I
+>>
 endobj
 252 0 obj
 << /Type /Annot
 /Subtype /Link
-/Rect [ 345.52 637.683 367.18 627.683 ]
+/Rect [ 120.0 615.683 280.52 605.683 ]
 /C [ 0 0 0 ]
 /Border [ 0 0 0 ]
-/A << /URI (http://uffi.b9.com)
+/A << /URI (http://www.sourceforge.net/projects/cclan)
 /S /URI >>
 /H /I
 >>
@@ -1622,10 +1640,10 @@
 253 0 obj
 << /Type /Annot
 /Subtype /Link
-/Rect [ 628.87 626.683 660.55 616.683 ]
+/Rect [ 156.67 604.683 172.22 594.683 ]
 /C [ 0 0 0 ]
 /Border [ 0 0 0 ]
-/A << /URI (http://www.sourceforge.net/projects/cclan)
+/A << /URI (http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/cclan/asdf/asdf.lisp)
 /S /URI >>
 /H /I
 >>
@@ -1633,7 +1651,7 @@
 254 0 obj
 << /Type /Annot
 /Subtype /Link
-/Rect [ 178.61 604.683 194.16 594.683 ]
+/Rect [ 178.05 604.683 440.79 594.683 ]
 /C [ 0 0 0 ]
 /Border [ 0 0 0 ]
 /A << /URI (http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/cclan/asdf/asdf.lisp)
@@ -1642,10 +1660,10 @@
 >>
 endobj
 255 0 obj
-<< /Length 286 /Filter [ /ASCII85Decode /FlateDecode ]
+<< /Length 280 /Filter [ /ASCII85Decode /FlateDecode ]
  >>
 stream
-GarVI4)]a*&Dm at 9D@Am;T3oANU/7[j,]?6ZJfq?%\95m>IpYQp5Ua5*e(sc.]?H at t>QC*I8HbEL0Xq\t(()5IP^uS-WauU9L%FH5EVFh=s!%4Bo+e&.O9JMn:*Sad6Rt__:7nQAq9%R*#e#QR0\tfNY3`8p[Z4X#q77uTQhSWuMM5Dd]L47gf5dZ=@X!Gf=/3Buh5=
+GarVI]afWJ&Dm9u2p,Oq5;7s,UROh6F[-#*#uI``q">Jf5_uu4bMDo6GDSeiPQMRYME'f4&\&tk`#",h at 0.p9YnA5D)GZ2rAY7;m]`Ycp5'X%08j(3'#8(NQ6V2iC(k5PbFbR@`!A#[Z]BLMf20j!(['ai+_Ne81r4HZkJku
 endstream
 endobj
 256 0 obj
@@ -2227,21 +2245,29 @@
 /BaseFont /Courier
 /Encoding /WinAnsiEncoding >>
 endobj
+332 0 obj
+<< /Type /Font
+/Subtype /Type1
+/Name /F7
+/BaseFont /Times-Bold
+/Encoding /WinAnsiEncoding >>
+endobj
 1 0 obj
 << /Type /Pages
-/Count 62
-/Kids [6 0 R 8 0 R 10 0 R 12 0 R 121 0 R 140 0 R 142 0 R 144 0 R 146 0 R 148 0 R 150 0 R 152 0 R 154 0 R 156 0 R 158 0 R 160 0 R 162 0 R 164 0 R 166 0 R 168 0 R 170 0 R 172 0 R 174 0 R 176 0 R 178 0 R 180 0 R 182 0 R 184 0 R 186 0 R 188 0 R 190 0 R 192 0 R 194 0 R 196 0 R 198 0 R 200 0 R 202 0 R 204 0 R 206 0 R 208 0 R 210 0 R 212 0 R 214 0 R 216 0 R 218 0 R 220 0 R 222 0 R 224 0 R 226 0 R 228 0 R 230 0 R 232 0 R 234 0 R 236 0 R 238 0 R 240 0 R 242 0 R 244 0 R 246 0 R 248 0 R 250 0 R 256 0 R ] >>
+/Count 60
+/Kids [6 0 R 8 0 R 10 0 R 12 0 R 121 0 R 140 0 R 142 0 R 144 0 R 146 0 R 148 0 R 150 0 R 152 0 R 154 0 R 156 0 R 158 0 R 160 0 R 162 0 R 164 0 R 166 0 R 168 0 R 170 0 R 172 0 R 174 0 R 176 0 R 178 0 R 180 0 R 182 0 R 184 0 R 186 0 R 188 0 R 190 0 R 192 0 R 194 0 R 196 0 R 198 0 R 200 0 R 202 0 R 204 0 R 206 0 R 208 0 R 210 0 R 212 0 R 214 0 R 216 0 R 218 0 R 220 0 R 222 0 R 224 0 R 226 0 R 228 0 R 230 0 R 232 0 R 234 0 R 236 0 R 238 0 R 240 0 R 242 0 R 244 0 R 246 0 R 256 0 R ] >>
 endobj
 2 0 obj
 << /Type /Catalog
 /Pages 1 0 R
  /Outlines 257 0 R
  /PageMode /UseOutlines
+ /Names << /Dests << /Names [  (preface) [ 140 0 R /XYZ 115.0 725.0 null ] (introduction) [ 142 0 R /XYZ 115.0 725.0 null ] (notes) [ 146 0 R /XYZ 115.0 725.0 null ] (ref_declarations) [ 150 0 R /XYZ 115.0 725.0 null ] (primitives) [ 154 0 R /XYZ 115.0 725.0 null ] (aggregates) [ 162 0 R /XYZ 115.0 725.0 null ] (objects) [ 182 0 R /XYZ 115.0 725.0 null ] (strings) [ 216 0 R /XYZ 115.0 725.0 null ] (func_libr) [ 234 0 R /XYZ 115.0 725.0 null ] (installation) [ 246 0 R /XYZ 115.0 725.0 null ] (glossary) [ 256 0 R /XYZ 115.0 725.0 null ] (id2254977) [ 10 0 R /XYZ 115.0 725.0 null ] ] >> >>
  >>
 endobj
 3 0 obj
 << 
-/Font << /F3 325 0 R /F5 326 0 R /F10 327 0 R /F6 329 0 R /F1 328 0 R /F4 330 0 R /F9 331 0 R >> 
+/Font << /F3 325 0 R /F5 326 0 R /F10 327 0 R /F6 329 0 R /F1 328 0 R /F4 330 0 R /F9 331 0 R /F7 332 0 R >> 
 /ProcSet [ /PDF /ImageC /Text ] >> 
 endobj
 15 0 obj
@@ -2349,7 +2375,7 @@
 49 0 obj
 <<
 /S /GoTo
-/D [null /XYZ 0.0 0.0 null]
+/D [150 0 R /XYZ 115.0 725.0 null]
 >>
 endobj
 51 0 obj
@@ -2361,7 +2387,7 @@
 53 0 obj
 <<
 /S /GoTo
-/D [154 0 R /XYZ 115.0 678.347 null]
+/D [154 0 R /XYZ 115.0 725.0 null]
 >>
 endobj
 55 0 obj
@@ -2385,7 +2411,7 @@
 61 0 obj
 <<
 /S /GoTo
-/D [162 0 R /XYZ 115.0 678.347 null]
+/D [162 0 R /XYZ 115.0 725.0 null]
 >>
 endobj
 63 0 obj
@@ -2433,7 +2459,7 @@
 77 0 obj
 <<
 /S /GoTo
-/D [182 0 R /XYZ 115.0 678.347 null]
+/D [182 0 R /XYZ 115.0 725.0 null]
 >>
 endobj
 79 0 obj
@@ -2517,7 +2543,7 @@
 105 0 obj
 <<
 /S /GoTo
-/D [216 0 R /XYZ 115.0 678.347 null]
+/D [216 0 R /XYZ 115.0 725.0 null]
 >>
 endobj
 107 0 obj
@@ -2547,61 +2573,61 @@
 115 0 obj
 <<
 /S /GoTo
-/D [230 0 R /XYZ 115.0 725.0 null]
+/D [228 0 R /XYZ 115.0 725.0 null]
 >>
 endobj
 117 0 obj
 <<
 /S /GoTo
-/D [232 0 R /XYZ 115.0 725.0 null]
+/D [230 0 R /XYZ 115.0 725.0 null]
 >>
 endobj
 119 0 obj
 <<
 /S /GoTo
-/D [234 0 R /XYZ 115.0 725.0 null]
+/D [232 0 R /XYZ 115.0 725.0 null]
 >>
 endobj
 124 0 obj
 <<
 /S /GoTo
-/D [236 0 R /XYZ 115.0 725.0 null]
+/D [234 0 R /XYZ 115.0 725.0 null]
 >>
 endobj
 126 0 obj
 <<
 /S /GoTo
-/D [238 0 R /XYZ 115.0 725.0 null]
+/D [236 0 R /XYZ 115.0 725.0 null]
 >>
 endobj
 128 0 obj
 <<
 /S /GoTo
-/D [242 0 R /XYZ 115.0 725.0 null]
+/D [240 0 R /XYZ 115.0 725.0 null]
 >>
 endobj
 130 0 obj
 <<
 /S /GoTo
-/D [246 0 R /XYZ 115.0 725.0 null]
+/D [244 0 R /XYZ 115.0 725.0 null]
 >>
 endobj
 132 0 obj
 <<
 /S /GoTo
-/D [250 0 R /XYZ 115.0 725.0 null]
+/D [246 0 R /XYZ 115.0 725.0 null]
 >>
 endobj
 134 0 obj
 <<
 /S /GoTo
-/D [250 0 R /XYZ 115.0 687.009 null]
+/D [246 0 R /XYZ 115.0 687.009 null]
 >>
 endobj
 136 0 obj
 <<
 /S /GoTo
-/D [250 0 R /XYZ 115.0 599.683 null]
+/D [246 0 R /XYZ 115.0 599.683 null]
 >>
 endobj
 138 0 obj
@@ -2634,345 +2660,346 @@
 >>
 endobj
 xref
-0 332
+0 333
 0000000000 65535 f 
-0000086303 00000 n 
-0000086846 00000 n 
-0000086939 00000 n 
+0000087336 00000 n 
+0000087863 00000 n 
+0000088550 00000 n 
 0000000015 00000 n 
 0000000071 00000 n 
-0000000352 00000 n 
-0000000458 00000 n 
-0000001520 00000 n 
-0000001626 00000 n 
-0000001787 00000 n 
-0000001894 00000 n 
-0000003922 00000 n 
-0000004045 00000 n 
-0000004446 00000 n 
-0000087092 00000 n 
-0000004582 00000 n 
-0000087158 00000 n 
-0000004718 00000 n 
-0000087224 00000 n 
-0000004854 00000 n 
-0000087292 00000 n 
-0000004990 00000 n 
-0000087360 00000 n 
-0000005126 00000 n 
-0000087428 00000 n 
-0000005262 00000 n 
-0000087496 00000 n 
-0000005398 00000 n 
-0000087564 00000 n 
-0000005534 00000 n 
-0000087630 00000 n 
-0000005670 00000 n 
-0000087696 00000 n 
-0000005806 00000 n 
-0000087764 00000 n 
-0000005942 00000 n 
-0000087832 00000 n 
-0000006078 00000 n 
-0000087900 00000 n 
-0000006214 00000 n 
-0000087968 00000 n 
-0000006350 00000 n 
-0000088036 00000 n 
-0000006486 00000 n 
-0000088103 00000 n 
-0000006622 00000 n 
-0000088171 00000 n 
-0000006758 00000 n 
-0000088239 00000 n 
-0000006894 00000 n 
-0000088298 00000 n 
-0000007030 00000 n 
-0000088364 00000 n 
-0000007166 00000 n 
-0000088432 00000 n 
-0000007302 00000 n 
-0000088498 00000 n 
-0000007438 00000 n 
-0000088564 00000 n 
-0000007574 00000 n 
-0000088630 00000 n 
-0000007710 00000 n 
-0000088698 00000 n 
-0000007846 00000 n 
-0000088764 00000 n 
-0000007982 00000 n 
-0000088830 00000 n 
-0000008118 00000 n 
-0000088896 00000 n 
-0000008254 00000 n 
-0000088962 00000 n 
-0000008389 00000 n 
-0000089028 00000 n 
-0000008525 00000 n 
-0000089094 00000 n 
-0000008661 00000 n 
-0000089160 00000 n 
-0000008796 00000 n 
-0000089228 00000 n 
-0000008932 00000 n 
-0000089294 00000 n 
-0000009068 00000 n 
-0000089360 00000 n 
-0000009204 00000 n 
-0000089426 00000 n 
-0000009340 00000 n 
-0000089492 00000 n 
-0000009476 00000 n 
-0000089558 00000 n 
-0000009611 00000 n 
-0000089624 00000 n 
-0000009747 00000 n 
-0000089690 00000 n 
-0000009883 00000 n 
-0000089756 00000 n 
-0000010019 00000 n 
-0000089822 00000 n 
-0000010155 00000 n 
-0000089888 00000 n 
-0000010291 00000 n 
-0000089954 00000 n 
-0000010429 00000 n 
-0000090021 00000 n 
-0000010567 00000 n 
-0000090088 00000 n 
-0000010705 00000 n 
-0000090157 00000 n 
-0000010843 00000 n 
-0000090224 00000 n 
-0000010981 00000 n 
-0000090291 00000 n 
-0000011119 00000 n 
-0000090358 00000 n 
-0000011257 00000 n 
-0000090425 00000 n 
-0000011394 00000 n 
-0000090492 00000 n 
-0000011530 00000 n 
-0000090559 00000 n 
-0000011666 00000 n 
-0000012265 00000 n 
-0000012391 00000 n 
-0000012476 00000 n 
-0000090626 00000 n 
-0000012610 00000 n 
-0000090693 00000 n 
-0000012744 00000 n 
-0000090760 00000 n 
-0000012878 00000 n 
-0000090827 00000 n 
-0000013012 00000 n 
-0000090894 00000 n 
-0000013146 00000 n 
-0000090961 00000 n 
-0000013280 00000 n 
-0000091030 00000 n 
-0000013414 00000 n 
-0000091099 00000 n 
-0000013548 00000 n 
-0000014206 00000 n 
-0000014316 00000 n 
-0000016365 00000 n 
-0000016475 00000 n 
-0000017651 00000 n 
-0000017761 00000 n 
-0000020167 00000 n 
-0000020277 00000 n 
-0000020735 00000 n 
-0000020845 00000 n 
-0000021401 00000 n 
-0000021511 00000 n 
-0000022412 00000 n 
-0000022522 00000 n 
-0000023804 00000 n 
-0000023914 00000 n 
-0000024967 00000 n 
-0000025077 00000 n 
-0000025901 00000 n 
-0000026011 00000 n 
-0000027198 00000 n 
-0000027308 00000 n 
-0000027688 00000 n 
-0000027798 00000 n 
-0000029585 00000 n 
-0000029695 00000 n 
-0000030019 00000 n 
-0000030129 00000 n 
-0000031265 00000 n 
-0000031375 00000 n 
-0000032223 00000 n 
-0000032333 00000 n 
-0000033243 00000 n 
-0000033353 00000 n 
-0000034114 00000 n 
-0000034224 00000 n 
-0000035421 00000 n 
-0000035531 00000 n 
-0000035870 00000 n 
-0000035980 00000 n 
-0000036961 00000 n 
-0000037071 00000 n 
-0000037465 00000 n 
-0000037575 00000 n 
-0000038630 00000 n 
-0000038740 00000 n 
-0000039424 00000 n 
-0000039534 00000 n 
-0000040883 00000 n 
-0000040993 00000 n 
-0000041909 00000 n 
-0000042019 00000 n 
-0000042717 00000 n 
-0000042827 00000 n 
-0000043949 00000 n 
-0000044059 00000 n 
-0000044387 00000 n 
-0000044497 00000 n 
-0000045663 00000 n 
-0000045773 00000 n 
-0000046880 00000 n 
-0000046990 00000 n 
-0000047770 00000 n 
-0000047880 00000 n 
-0000048625 00000 n 
-0000048735 00000 n 
-0000049250 00000 n 
-0000049360 00000 n 
-0000051132 00000 n 
-0000051242 00000 n 
-0000051585 00000 n 
-0000051695 00000 n 
-0000053137 00000 n 
-0000053247 00000 n 
-0000053943 00000 n 
-0000054053 00000 n 
-0000056145 00000 n 
-0000056255 00000 n 
-0000056624 00000 n 
-0000056734 00000 n 
-0000057542 00000 n 
-0000057652 00000 n 
-0000058457 00000 n 
-0000058567 00000 n 
-0000059308 00000 n 
-0000059418 00000 n 
-0000060548 00000 n 
-0000060658 00000 n 
-0000060926 00000 n 
-0000061036 00000 n 
-0000062117 00000 n 
-0000062227 00000 n 
-0000062953 00000 n 
-0000063063 00000 n 
-0000064038 00000 n 
-0000064148 00000 n 
-0000064439 00000 n 
-0000064549 00000 n 
-0000066018 00000 n 
-0000066128 00000 n 
-0000066456 00000 n 
-0000066566 00000 n 
-0000068176 00000 n 
-0000068286 00000 n 
-0000068622 00000 n 
-0000068732 00000 n 
-0000070127 00000 n 
-0000070237 00000 n 
-0000070512 00000 n 
-0000070622 00000 n 
-0000071738 00000 n 
-0000071864 00000 n 
-0000071909 00000 n 
-0000072080 00000 n 
-0000072274 00000 n 
-0000072494 00000 n 
-0000072873 00000 n 
-0000091166 00000 n 
-0000091220 00000 n 
+0000000363 00000 n 
+0000000469 00000 n 
+0000001525 00000 n 
+0000001631 00000 n 
+0000001792 00000 n 
+0000001899 00000 n 
+0000003924 00000 n 
+0000004047 00000 n 
+0000004448 00000 n 
+0000088715 00000 n 
+0000004584 00000 n 
+0000088781 00000 n 
+0000004720 00000 n 
+0000088847 00000 n 
+0000004856 00000 n 
+0000088915 00000 n 
+0000004992 00000 n 
+0000088983 00000 n 
+0000005128 00000 n 
+0000089051 00000 n 
+0000005264 00000 n 
+0000089119 00000 n 
+0000005400 00000 n 
+0000089187 00000 n 
+0000005536 00000 n 
+0000089253 00000 n 
+0000005672 00000 n 
+0000089319 00000 n 
+0000005808 00000 n 
+0000089387 00000 n 
+0000005944 00000 n 
+0000089455 00000 n 
+0000006080 00000 n 
+0000089523 00000 n 
+0000006216 00000 n 
+0000089591 00000 n 
+0000006352 00000 n 
+0000089659 00000 n 
+0000006488 00000 n 
+0000089726 00000 n 
+0000006624 00000 n 
+0000089794 00000 n 
+0000006760 00000 n 
+0000089862 00000 n 
+0000006896 00000 n 
+0000089928 00000 n 
+0000007032 00000 n 
+0000089994 00000 n 
+0000007168 00000 n 
+0000090060 00000 n 
+0000007304 00000 n 
+0000090126 00000 n 
+0000007440 00000 n 
+0000090192 00000 n 
+0000007576 00000 n 
+0000090258 00000 n 
+0000007712 00000 n 
+0000090324 00000 n 
+0000007848 00000 n 
+0000090390 00000 n 
+0000007984 00000 n 
+0000090456 00000 n 
+0000008120 00000 n 
+0000090522 00000 n 
+0000008256 00000 n 
+0000090588 00000 n 
+0000008391 00000 n 
+0000090654 00000 n 
+0000008527 00000 n 
+0000090720 00000 n 
+0000008663 00000 n 
+0000090786 00000 n 
+0000008798 00000 n 
+0000090852 00000 n 
+0000008934 00000 n 
+0000090918 00000 n 
+0000009070 00000 n 
+0000090984 00000 n 
+0000009206 00000 n 
+0000091050 00000 n 
+0000009342 00000 n 
+0000091116 00000 n 
+0000009478 00000 n 
+0000091182 00000 n 
+0000009613 00000 n 
+0000091248 00000 n 
+0000009749 00000 n 
+0000091314 00000 n 
+0000009885 00000 n 
+0000091380 00000 n 
+0000010021 00000 n 
+0000091446 00000 n 
+0000010157 00000 n 
+0000091512 00000 n 
+0000010293 00000 n 
+0000091578 00000 n 
+0000010431 00000 n 
+0000091645 00000 n 
+0000010569 00000 n 
+0000091712 00000 n 
+0000010707 00000 n 
+0000091779 00000 n 
+0000010845 00000 n 
+0000091846 00000 n 
+0000010983 00000 n 
+0000091913 00000 n 
+0000011121 00000 n 
+0000091980 00000 n 
+0000011259 00000 n 
+0000092047 00000 n 
+0000011396 00000 n 
+0000092114 00000 n 
+0000011532 00000 n 
+0000092181 00000 n 
+0000011668 00000 n 
+0000012297 00000 n 
+0000012423 00000 n 
+0000012508 00000 n 
+0000092248 00000 n 
+0000012642 00000 n 
+0000092315 00000 n 
+0000012776 00000 n 
+0000092382 00000 n 
+0000012910 00000 n 
+0000092449 00000 n 
+0000013044 00000 n 
+0000092516 00000 n 
+0000013178 00000 n 
+0000092583 00000 n 
+0000013312 00000 n 
+0000092652 00000 n 
+0000013446 00000 n 
+0000092721 00000 n 
+0000013580 00000 n 
+0000014239 00000 n 
+0000014349 00000 n 
+0000016398 00000 n 
+0000016508 00000 n 
+0000017682 00000 n 
+0000017792 00000 n 
+0000020198 00000 n 
+0000020308 00000 n 
+0000020766 00000 n 
+0000020876 00000 n 
+0000021431 00000 n 
+0000021541 00000 n 
+0000022465 00000 n 
+0000022575 00000 n 
+0000023859 00000 n 
+0000023969 00000 n 
+0000025037 00000 n 
+0000025147 00000 n 
+0000025980 00000 n 
+0000026090 00000 n 
+0000027295 00000 n 
+0000027405 00000 n 
+0000027786 00000 n 
+0000027896 00000 n 
+0000029730 00000 n 
+0000029840 00000 n 
+0000030101 00000 n 
+0000030211 00000 n 
+0000031361 00000 n 
+0000031471 00000 n 
+0000032434 00000 n 
+0000032544 00000 n 
+0000033472 00000 n 
+0000033582 00000 n 
+0000034353 00000 n 
+0000034463 00000 n 
+0000035683 00000 n 
+0000035793 00000 n 
+0000036122 00000 n 
+0000036232 00000 n 
+0000037226 00000 n 
+0000037336 00000 n 
+0000037730 00000 n 
+0000037840 00000 n 
+0000038906 00000 n 
+0000039016 00000 n 
+0000039714 00000 n 
+0000039824 00000 n 
+0000041191 00000 n 
+0000041301 00000 n 
+0000042234 00000 n 
+0000042344 00000 n 
+0000043055 00000 n 
+0000043165 00000 n 
+0000044326 00000 n 
+0000044436 00000 n 
+0000044702 00000 n 
+0000044812 00000 n 
+0000045998 00000 n 
+0000046108 00000 n 
+0000047225 00000 n 
+0000047335 00000 n 
+0000048126 00000 n 
+0000048236 00000 n 
+0000048996 00000 n 
+0000049106 00000 n 
+0000049631 00000 n 
+0000049741 00000 n 
+0000051407 00000 n 
+0000051517 00000 n 
+0000051851 00000 n 
+0000051961 00000 n 
+0000053450 00000 n 
+0000053560 00000 n 
+0000054224 00000 n 
+0000054334 00000 n 
+0000056530 00000 n 
+0000056640 00000 n 
+0000057076 00000 n 
+0000057186 00000 n 
+0000058005 00000 n 
+0000058115 00000 n 
+0000058941 00000 n 
+0000059051 00000 n 
+0000059810 00000 n 
+0000059920 00000 n 
+0000061075 00000 n 
+0000061185 00000 n 
+0000062279 00000 n 
+0000062389 00000 n 
+0000063134 00000 n 
+0000063244 00000 n 
+0000064238 00000 n 
+0000064348 00000 n 
+0000064639 00000 n 
+0000064749 00000 n 
+0000066260 00000 n 
+0000066370 00000 n 
+0000066636 00000 n 
+0000066746 00000 n 
+0000068631 00000 n 
+0000068741 00000 n 
+0000069079 00000 n 
+0000069189 00000 n 
+0000070604 00000 n 
+0000070714 00000 n 
+0000071856 00000 n 
+0000071982 00000 n 
+0000072059 00000 n 
+0000072230 00000 n 
+0000072403 00000 n 
+0000072597 00000 n 
+0000072790 00000 n 
 0000072983 00000 n 
-0000091286 00000 n 
-0000073187 00000 n 
-0000073388 00000 n 
-0000073530 00000 n 
-0000073808 00000 n 
-0000073935 00000 n 
-0000074095 00000 n 
-0000074344 00000 n 
-0000074507 00000 n 
-0000074640 00000 n 
-0000074785 00000 n 
-0000075092 00000 n 
-0000075391 00000 n 
-0000075530 00000 n 
-0000075684 00000 n 
-0000075799 00000 n 
-0000076135 00000 n 
-0000076415 00000 n 
-0000076560 00000 n 
-0000076841 00000 n 
-0000091352 00000 n 
-0000077055 00000 n 
-0000077189 00000 n 
-0000077321 00000 n 
-0000077552 00000 n 
-0000077708 00000 n 
-0000077902 00000 n 
-0000078051 00000 n 
-0000078282 00000 n 
-0000078414 00000 n 
-0000078573 00000 n 
-0000078755 00000 n 
-0000078949 00000 n 
-0000079149 00000 n 
-0000079314 00000 n 
-0000079452 00000 n 
-0000079637 00000 n 
-0000079858 00000 n 
-0000080070 00000 n 
-0000080282 00000 n 
-0000080499 00000 n 
-0000080688 00000 n 
-0000080865 00000 n 
-0000081089 00000 n 
-0000081301 00000 n 
-0000081501 00000 n 
-0000081683 00000 n 
-0000081911 00000 n 
-0000082112 00000 n 
-0000082286 00000 n 
-0000082471 00000 n 
-0000082675 00000 n 
-0000082882 00000 n 
-0000083054 00000 n 
-0000083226 00000 n 
-0000083486 00000 n 
-0000083734 00000 n 
-0000083956 00000 n 
-0000084222 00000 n 
-0000084379 00000 n 
-0000084598 00000 n 
-0000084802 00000 n 
-0000085088 00000 n 
-0000085251 00000 n 
-0000085379 00000 n 
-0000085513 00000 n 
-0000085627 00000 n 
-0000085738 00000 n 
-0000085854 00000 n 
-0000085963 00000 n 
-0000086075 00000 n 
-0000086196 00000 n 
+0000073203 00000 n 
+0000073423 00000 n 
+0000073796 00000 n 
+0000092788 00000 n 
+0000092842 00000 n 
+0000073906 00000 n 
+0000092908 00000 n 
+0000074110 00000 n 
+0000074311 00000 n 
+0000074453 00000 n 
+0000074731 00000 n 
+0000074858 00000 n 
+0000075018 00000 n 
+0000075267 00000 n 
+0000075430 00000 n 
+0000075563 00000 n 
+0000075708 00000 n 
+0000076015 00000 n 
+0000076314 00000 n 
+0000076453 00000 n 
+0000076607 00000 n 
+0000076722 00000 n 
+0000077058 00000 n 
+0000077338 00000 n 
+0000077483 00000 n 
+0000077764 00000 n 
+0000092974 00000 n 
+0000077978 00000 n 
+0000078112 00000 n 
+0000078244 00000 n 
+0000078475 00000 n 
+0000078631 00000 n 
+0000078825 00000 n 
+0000078974 00000 n 
+0000079205 00000 n 
+0000079337 00000 n 
+0000079496 00000 n 
+0000079678 00000 n 
+0000079872 00000 n 
+0000080072 00000 n 
+0000080237 00000 n 
+0000080375 00000 n 
+0000080560 00000 n 
+0000080781 00000 n 
+0000080993 00000 n 
+0000081205 00000 n 
+0000081422 00000 n 
+0000081611 00000 n 
+0000081788 00000 n 
+0000082012 00000 n 
+0000082224 00000 n 
+0000082424 00000 n 
+0000082606 00000 n 
+0000082834 00000 n 
+0000083035 00000 n 
+0000083209 00000 n 
+0000083394 00000 n 
+0000083598 00000 n 
+0000083805 00000 n 
+0000083977 00000 n 
+0000084149 00000 n 
+0000084409 00000 n 
+0000084657 00000 n 
+0000084879 00000 n 
+0000085145 00000 n 
+0000085302 00000 n 
+0000085521 00000 n 
+0000085725 00000 n 
+0000086011 00000 n 
+0000086174 00000 n 
+0000086302 00000 n 
+0000086436 00000 n 
+0000086550 00000 n 
+0000086661 00000 n 
+0000086777 00000 n 
+0000086886 00000 n 
+0000086998 00000 n 
+0000087119 00000 n 
+0000087226 00000 n 
 trailer
 <<
-/Size 332
+/Size 333
 /Root 2 0 R
 /Info 4 0 R
 >>
 startxref
-91421
+93043
 %%EOF

Modified: branches/xml-class-rework/thirdparty/uffi/examples/Makefile
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/examples/Makefile	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/examples/Makefile	2006-10-22 16:42:37 UTC (rev 2025)
@@ -5,13 +5,10 @@
 #  Programer:    Kevin M. Rosenberg
 #  Date Started: Mar 2002
 #
-#  CVS Id:   $Id: Makefile,v 1.1 2004/06/23 08:27:10 hans Exp $
+#  CVS Id:   $Id$
 #
-# This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+# This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 #
-# UFFI users are granted the rights to distribute and use this software
-# as governed by the terms of the Lisp Lesser GNU Public License
-# (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 
 SUBDIRS:=
 

Modified: branches/xml-class-rework/thirdparty/uffi/examples/Makefile.msvc
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/examples/Makefile.msvc	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/examples/Makefile.msvc	2006-10-22 16:42:37 UTC (rev 2025)
@@ -5,13 +5,9 @@
 #  Programer:    Kevin M. Rosenberg
 #  Date Started: Mar 2002
 #
-#  CVS Id:   $Id: Makefile.msvc,v 1.1 2004/06/23 08:27:10 hans Exp $
+#  CVS Id:   $Id$
 #
-# This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
-#
-# CLSQL users are granted the rights to distribute and use this software
-# as governed by the terms of the Lisp Lesser GNU Public License
-# (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+# This file, part of CLSQL, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 
 BASE=c-test-fns
 

Modified: branches/xml-class-rework/thirdparty/uffi/examples/acl-compat-tester.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/examples/acl-compat-tester.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/examples/acl-compat-tester.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -24,7 +24,7 @@
 ;; Place, Suite 330, Boston, MA  02111-1307  USA
 ;;
 ;;;; from the original ACL 6.1 sources:
-;; $Id: acl-compat-tester.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;; $Id$
 
 
 (defpackage :util.test

Modified: branches/xml-class-rework/thirdparty/uffi/examples/arrays.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/examples/arrays.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/examples/arrays.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,13 +7,10 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Mar 2002
 ;;;;
-;;;; $Id: arrays.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 (in-package :cl-user)
@@ -21,7 +18,7 @@
 (uffi:def-constant +column-length+ 10)
 (uffi:def-constant +row-length+ 10)
 
-(uffi:def-foreign-type long-ptr '(* :long))
+(uffi:def-foreign-type long-ptr (* :long))
 
 (defun test-array-1d ()
   "Tests vector"

Modified: branches/xml-class-rework/thirdparty/uffi/examples/atoifl.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/examples/atoifl.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/examples/atoifl.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,13 +7,10 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Mar 2002
 ;;;;
-;;;; $Id: atoifl.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 (in-package :cl-user)

Modified: branches/xml-class-rework/thirdparty/uffi/examples/c-test-fns.c
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/examples/c-test-fns.c	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/examples/c-test-fns.c	2006-10-22 16:42:37 UTC (rev 2025)
@@ -6,14 +6,10 @@
  *  Programer:    Kevin M. Rosenberg
  *  Date Started: Mar 2002
  *
- *  CVS Id:   $Id: c-test-fns.c,v 1.1 2004/06/23 08:27:10 hans Exp $
+ *  CVS Id:   $Id$
  *
- * This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+ * This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
  *
- * UFFI users are granted the rights to distribute and use this software
- * as governed by the terms of the Lisp Lesser GNU Public License
- * (http://opensource.franz.com/preamble.html), also known as the LLGPL.
-
  * These variables are correct for GCC
  * you'll need to modify these for other compilers
  ***************************************************************************/

Modified: branches/xml-class-rework/thirdparty/uffi/examples/c-test-fns.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/examples/c-test-fns.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/examples/c-test-fns.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,13 +7,10 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Mar 2002
 ;;;;
-;;;; $Id: c-test-fns.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 (in-package :cl-user)

Modified: branches/xml-class-rework/thirdparty/uffi/examples/compress.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/examples/compress.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/examples/compress.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,13 +7,10 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: compress.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 (in-package :cl-user)

Modified: branches/xml-class-rework/thirdparty/uffi/examples/file-socket.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/examples/file-socket.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/examples/file-socket.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,13 +7,10 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Jul 2002
 ;;;;
-;;;; $Id: file-socket.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 (in-package :cl-user)

Modified: branches/xml-class-rework/thirdparty/uffi/examples/getenv.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/examples/getenv.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/examples/getenv.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,13 +7,10 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: getenv.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 (in-package :cl-user)

Modified: branches/xml-class-rework/thirdparty/uffi/examples/gethostname.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/examples/gethostname.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/examples/gethostname.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,13 +7,10 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: gethostname.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 (in-package :cl-user)

Modified: branches/xml-class-rework/thirdparty/uffi/examples/getshells.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/examples/getshells.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/examples/getshells.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,13 +7,10 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Mar 2002
 ;;;;
-;;;; $Id: getshells.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 (in-package :cl-user)

Modified: branches/xml-class-rework/thirdparty/uffi/examples/gettime.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/examples/gettime.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/examples/gettime.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,13 +7,10 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: gettime.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 (in-package :cl-user)

Modified: branches/xml-class-rework/thirdparty/uffi/examples/run-examples.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/examples/run-examples.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/examples/run-examples.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,13 +7,10 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: run-examples.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 #-uffi (asdf:oos 'asdf:load-op :uffi)

Modified: branches/xml-class-rework/thirdparty/uffi/examples/strtol.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/examples/strtol.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/examples/strtol.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,13 +7,10 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: strtol.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 (in-package :cl-user)

Modified: branches/xml-class-rework/thirdparty/uffi/examples/test-examples.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/examples/test-examples.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/examples/test-examples.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,13 +7,10 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: test-examples.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 #-uffi (asdf:oos 'asdf:load-op :uffi)

Modified: branches/xml-class-rework/thirdparty/uffi/examples/union.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/examples/union.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/examples/union.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,13 +7,10 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Mar 2002
 ;;;;
-;;;; $Id: union.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 (in-package :cl-user)
@@ -69,7 +66,7 @@
 	       #\A
 	       :test #'eql
 	       :fail-info "Error with union character")
-    #-(or sparc sparc-v9 mcl)
+    #-(or sparc sparc-v9 openmcl digitool)
 ;;    (util.test:test (> 0 (uffi:get-slot-value u 'tunion1 'int))
 ;;	       t
 ;;	       :fail-info

Modified: branches/xml-class-rework/thirdparty/uffi/src/aggregates.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/src/aggregates.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/src/aggregates.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,13 +7,10 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: aggregates.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2005 by Kevin M. Rosenberg
 ;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 (in-package #:uffi)
@@ -45,7 +42,7 @@
 		       #+lispworks `((fli:define-c-typedef ,enum-name :int))
 		       #+(or cmu scl) `((alien:def-alien-type ,enum-name alien:signed))
 		       #+sbcl `((sb-alien:define-alien-type ,enum-name sb-alien:signed))
-                       #+(and mcl (not openmcl)) `((def-mcl-type ,enum-name :integer))
+                       #+digitool `((def-mcl-type ,enum-name :integer))
                        #+openmcl `((ccl::def-foreign-type ,enum-name :int))
 		       (nreverse constants)))
     cmds))
@@ -64,7 +61,7 @@
   #+sbcl
   `(sb-alien:define-alien-type ,name-array 
     (* ,(convert-from-uffi-type type :array)))
-  #+(and mcl (not openmcl))
+  #+digitool
   `(def-mcl-type ,name-array '(:array ,type))
   #+openmcl
   `(ccl::def-foreign-type ,name-array (:array ,(convert-from-uffi-type type :array)))
@@ -79,9 +76,9 @@
 			  (if (eq type :pointer-self)
 			      #+(or cmu scl) `((* (alien:struct ,name)))
 			      #+sbcl `((* (sb-alien:struct ,name)))
-			      #+mcl `((:* (:struct ,name)))
+			      #+(or openmcl digitool) `((:* (:struct ,name)))
 			      #+lispworks `((:pointer ,name))
-			      #-(or cmu sbcl scl mcl lispworks) `((* ,name))
+			      #-(or cmu sbcl scl openmcl digitool lispworks) `((* ,name))
 			      `(,(convert-from-uffi-type type :struct))))))
 	(if variant
 	    (push (list def) processed)
@@ -98,7 +95,7 @@
   `(ff:def-foreign-type ,name (:struct ,@(process-struct-fields name fields)))
   #+lispworks
   `(fli:define-c-struct ,name ,@(process-struct-fields name fields))
-  #+(and mcl (not openmcl))
+  #+digitool
   `(ccl:defrecord ,name ,@(process-struct-fields name fields))
   #+openmcl
   `(ccl::def-foreign-type
@@ -117,15 +114,15 @@
   `(alien:slot ,obj ,slot)
   #+sbcl
   `(sb-alien:slot ,obj ,slot)
-  #+mcl
+  #+(or openmcl digitool)
   `(ccl:pref ,obj ,(read-from-string (format nil ":~a.~a" (keyword type) (keyword slot))))
   )
 
-#+mcl
+#+(or openmcl digitool)
 (defmacro set-slot-value (obj type slot value) ;use setf to set values
   `(setf (ccl:pref ,obj ,(read-from-string (format nil ":~a.~a" (keyword type) (keyword slot)))) ,value))
 
-#+mcl
+#+(or openmcl digitool)
 (defsetf get-slot-value set-slot-value)
 
 
@@ -139,42 +136,54 @@
   `(alien:slot ,obj ,slot)
   #+sbcl
   `(sb-alien:slot ,obj ,slot)
-  #+(and mcl (not openmcl))
+  #+digitool
   `(ccl:%int-to-ptr (+ (ccl:%ptr-to-int ,obj) (the fixnum (ccl:field-info ,type ,slot))))
   #+openmcl
   `(let ((field (ccl::%find-foreign-record-type-field ,type ,slot)))
      (ccl:%int-to-ptr (+ (ccl:%ptr-to-int ,obj) (the fixnum (ccl::foreign-record-field-offset field)))))  
 )
 
-; so we could allow '(:array :long) or deref with other type like :long only
-#+mcl
-(defun array-type (type)
-  (let ((result type))
-    (when (listp type)
-      (let ((type-list (if (eq (car type) 'quote) (nth 1 type) type)))
-        (when (and (listp type-list) (eq (car type-list) :array))
-          (setf result (cadr type-list)))))
-    result))
-
-
-(defmacro deref-array (obj type i)
-  "Returns a field from a row"
-  #+(or lispworks cmu sbcl scl) (declare (ignore type))
-  #+(or cmu scl)  `(alien:deref ,obj ,i)
-  #+sbcl  `(sb-alien:deref ,obj ,i)
-  #+lispworks `(fli:dereference ,obj :index ,i :copy-foreign-object nil)
-  #+allegro `(ff:fslot-value-typed (quote ,(convert-from-uffi-type type :type)) :c ,obj ,i)
-  #+mcl
-  (let* ((array-type (array-type type))
-         (local-type (convert-from-uffi-type array-type :allocation))
-         (accessor (first (macroexpand `(ccl:pref obj ,local-type)))))
-    `(,accessor 
-      ,obj
-      (* (the fixnum ,i) ,(size-of-foreign-type local-type))))
-  )
-
+;; necessary to eval at compile time for openmcl to compile convert-from-foreign-usb8
+;; below
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  ;; so we could allow '(:array :long) or deref with other type like :long only
+  #+(or openmcl digitool)
+  (defun array-type (type)
+    (let ((result type))
+      (when (listp type)
+	(let ((type-list (if (eq (car type) 'quote) (nth 1 type) type)))
+	  (when (and (listp type-list) (eq (car type-list) :array))
+	    (setf result (cadr type-list)))))
+      result))
+  
+  
+  (defmacro deref-array (obj type i)
+    "Returns a field from a row"
+    #+(or lispworks cmu sbcl scl) (declare (ignore type))
+    #+(or cmu scl)  `(alien:deref ,obj ,i)
+    #+sbcl `(sb-alien:deref ,obj ,i)
+    #+lispworks `(fli:dereference ,obj :index ,i :copy-foreign-object nil)
+    #+allegro `(ff:fslot-value-typed (quote ,(convert-from-uffi-type type :type)) :c ,obj ,i)
+    #+openmcl
+    (let* ((array-type (array-type type))
+	   (local-type (convert-from-uffi-type array-type :allocation))
+	   (element-size-in-bits (ccl::%foreign-type-or-record-size local-type :bits)))
+      (ccl::%foreign-access-form
+       obj
+       (ccl::%foreign-type-or-record local-type)
+       `(* ,i ,element-size-in-bits)
+       nil))
+    #+digitool
+    (let* ((array-type (array-type type))
+	   (local-type (convert-from-uffi-type array-type :allocation))
+	   (accessor (first (macroexpand `(ccl:pref obj ,local-type)))))
+      `(,accessor
+	,obj
+	(* (the fixnum ,i) ,(size-of-foreign-type local-type))))
+    ))
+  
 ; this expands to the %set-xx functions which has different params than %put-xx
-#+mcl
+#+digitool
 (defmacro deref-array-set (obj type i value)
   (let* ((array-type (array-type type))
          (local-type (convert-from-uffi-type array-type :allocation))
@@ -185,7 +194,7 @@
       (* (the fixnum ,i) ,(size-of-foreign-type local-type)) 
       ,value)))
 
-#+mcl
+#+digitool
 (defsetf deref-array deref-array-set)
 
 (defmacro def-union (name &rest fields)
@@ -197,9 +206,57 @@
   `(alien:def-alien-type ,name (alien:union ,name ,@(process-struct-fields name fields)))
   #+sbcl
   `(sb-alien:define-alien-type ,name (sb-alien:union ,name ,@(process-struct-fields name fields)))
-  #+(and mcl (not openmcl))
+  #+digitool
   `(ccl:defrecord ,name (:variant ,@(process-struct-fields name fields t)))
   #+openmcl
   `(ccl::def-foreign-type nil 
 			  (:union ,name ,@(process-struct-fields name fields)))
 )
+
+
+#-(or sbcl cmu)
+(defun convert-from-foreign-usb8 (s len)
+  (declare (optimize (speed 3) (space 0) (safety 0) (compilation-speed 0))
+	   (fixnum len))
+  (let ((a (make-array len :element-type '(unsigned-byte 8))))
+    (dotimes (i len a)
+      (declare (fixnum i))
+      (setf (aref a i) (uffi:deref-array s '(:array :unsigned-byte) i)))))
+
+#+sbcl
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (sb-ext:without-package-locks
+      (defvar *system-copy-fn* (if (fboundp (intern "COPY-FROM-SYSTEM-AREA" "SB-KERNEL"))
+				   (intern "COPY-FROM-SYSTEM-AREA" "SB-KERNEL")
+				   (intern "COPY-UB8-FROM-SYSTEM-AREA" "SB-KERNEL")))
+    (defconstant +system-copy-offset+ (if (fboundp (intern "COPY-FROM-SYSTEM-AREA" "SB-KERNEL"))
+					  (* sb-vm:vector-data-offset sb-vm:n-word-bits)
+					  0))
+    (defconstant +system-copy-multiplier+ (if (fboundp (intern "COPY-FROM-SYSTEM-AREA" "SB-KERNEL"))
+					      sb-vm:n-byte-bits
+					      1))))
+  
+
+#+sbcl
+(defun convert-from-foreign-usb8 (s len)
+  (let ((sap (sb-alien:alien-sap s)))
+    (declare (type sb-sys:system-area-pointer sap))
+    (locally
+     (declare (optimize (speed 3) (safety 0)))
+     (let ((result (make-array len :element-type '(unsigned-byte 8))))
+       (funcall *system-copy-fn* sap 0 result +system-copy-offset+
+		(* len +system-copy-multiplier+))
+       result))))
+
+#+cmu
+(defun convert-from-foreign-usb8 (s len)
+  (let ((sap (alien:alien-sap s)))
+    (declare (type system:system-area-pointer sap))
+    (locally
+	(declare (optimize (speed 3) (safety 0)))
+      (let ((result (make-array len :element-type '(unsigned-byte 8))))
+	(kernel:copy-from-system-area sap 0
+				      result (* vm:vector-data-offset
+						vm:word-bits)
+				      (* len vm:byte-bits))
+	result))))

Modified: branches/xml-class-rework/thirdparty/uffi/src/corman/getenv-ccl.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/src/corman/getenv-ccl.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/src/corman/getenv-ccl.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,13 +7,8 @@
 ;;;; Programmer:    "Joe Marshall" 
 ;;;; Date Started:  Feb 2002
 ;;;;
-`;;;; $Id: getenv-ccl.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 (in-package :cl-user)

Modified: branches/xml-class-rework/thirdparty/uffi/src/functions.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/src/functions.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/src/functions.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,25 +7,22 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: functions.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2005 by Kevin M. Rosenberg
 ;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 (in-package #:uffi)
 
 (defun process-function-args (args)
   (if (null args)
-      #+(or lispworks cmu sbcl scl cormanlisp (and mcl (not openmcl))) nil
+      #+(or lispworks cmu sbcl scl cormanlisp digitool) nil
       #+allegro '(:void)
       #+openmcl (values nil nil)
 
       ;; args not null
-      #+(or lispworks allegro cmu sbcl scl (and mcl (not openmcl)) cormanlisp)
+      #+(or lispworks allegro cmu sbcl scl digitool cormanlisp)
       (let (processed)
 	(dolist (arg args)
 	  (push (process-one-function-arg arg) processed))
@@ -48,8 +45,9 @@
   (let ((name (car arg))
 	(type (convert-from-uffi-type (cadr arg) :routine)))
     #+(or cmu sbcl scl)
-    (list name type :in)
-    #+(or allegro lispworks (and mcl (not openmcl)))
+    ;(list name type :in)
+    `(,name ,type ,@(if (= (length arg) 3) (list (third arg)) (values)))
+    #+(or allegro lispworks digitool)
     (if (and (listp type) (listp (car type)))
 	(append (list name) type)
       (list name type))
@@ -63,10 +61,116 @@
       (list type)
     type))
 
+(defun funcallable-lambda-list (args)
+  (let ((ll nil))
+    (dolist (arg args)
+      (push (car arg) ll))
+    (nreverse ll)))
+
+#|
+(defmacro def-funcallable (name args &key returning)
+  (let ((result-type (convert-from-uffi-type returning :return))
+	(function-args (process-function-args args)))
+    #+lispworks
+    `(fli:define-foreign-funcallable ,name ,function-args
+      :result-type ,result-type
+      :language :ansi-c
+      :calling-convention :cdecl)
+    #+(or cmu scl sbcl)
+    ;; requires the type of the function pointer be declared correctly!
+    (let* ((ptrsym (gensym))
+	   (ll (funcallable-lambda-list args)))
+      `(defun ,name ,(cons ptrsym ll)
+	(alien::alien-funcall ,ptrsym , at ll)))
+    #+openmcl
+    (multiple-value-bind (params args) (process-function-args args)
+      (let ((ptrsym (gensym)))
+	`(defun ,name ,(cons ptrsym params)
+	  (ccl::ff-call ,ptrsym , at args ,result-type))))
+    #+allegro
+    ;; this is most definitely wrong
+    (let* ((ptrsym (gensym))
+	   (ll (funcallable-lambda-list args)))
+      `(defun ,name ,(cons ptrsym ll)
+	(system::ff-funcall ,ptrsym , at ll)))
+    ))
+|#    
+
+(defun convert-lispworks-args (args)
+  (loop for arg in args
+	with processed = nil
+	do
+	(if (and (= (length arg) 3) (eq (third arg) :out))
+	    (push (list (first arg)
+			(list :reference-return (second arg))) processed)
+	    (push (subseq arg 0 2) processed))
+	finally (return processed)))
+
+(defun preprocess-names (names)
+  (let ((fname (gensym)))
+    (if (atom names)
+	(values (list names fname) fname (uffi::make-lisp-name names))
+	(values (list (first names) fname) fname (second names)))))
+
+(defun preprocess-args (args)
+  (loop for arg in args
+	with lisp-args = nil and out = nil and processed = nil
+	do
+	(if (= (length arg) 3)
+	    (ecase (third arg)
+	      (:in 
+	       (progn
+		 (push (first arg) lisp-args)
+		 (push (list (first arg) (second arg)) processed)))
+	      (:out
+	       (progn
+		 (push (list (first arg) (second arg)) out)
+		 (push (list (first arg) (list '* (second arg))) processed))))
+	    (progn
+	      (push (first arg) lisp-args)
+	      (push arg processed)))
+	finally (return (values (nreverse lisp-args) 
+				(nreverse out) 
+				(nreverse processed)))))
+
+
+(defmacro def-function (names args &key module returning)
+  (multiple-value-bind (lisp-args out processed)
+      (preprocess-args args)
+    (declare (ignorable lisp-args processed))
+    (if (= (length out) 0)
+	`(%def-function ,names ,args 
+	  ,@(if module (list :module module) (values))
+	  ,@(if returning (list :returning returning) (values)))
+
+	#+(or cmu scl sbcl)
+	`(%def-function ,names ,args 
+	  ,@(if returning (list :returning returning) (values)))
+	#+lispworks
+	`(%def-function ,names ,(convert-lispworks-args args) 
+	  ,@(if module (list :module module) (values))
+	  ,@(if returning (list :returning returning) (values)))
+	#-(or cmu scl sbcl lispworks)
+	(multiple-value-bind (name-pair fname lisp-name)
+	    (preprocess-names names)
+	  `(prog1
+	    (%def-function ,name-pair ,processed 
+	     :module ,module :returning ,returning)
+	    ;(declaim (inline ,fname))
+	    (defun ,lisp-name ,lisp-args
+	      (with-foreign-objects ,out
+		(values (,fname ,@(mapcar #'first args))
+			,@(mapcar #'(lambda (arg)
+				      (list 'deref-pointer
+					    (first arg)
+					    (second arg))) out))))))
+	)))
+	
+
 ;; name is either a string representing foreign name, or a list
 ;; of foreign-name as a string and lisp name as a symbol
-(defmacro def-function (names args &key module returning)
-  #+(or cmu sbcl scl allegro mcl cormanlisp) (declare (ignore module))
+(defmacro %def-function (names args &key module returning)
+  #+(or cmu sbcl scl allegro openmcl digitool cormanlisp) (declare (ignore module))
   
   (let* ((result-type (convert-from-uffi-type returning :return))
 	 (function-args (process-function-args args))
@@ -94,8 +198,8 @@
        ,@(if module (list :module module) (values))
        :result-type ,result-type
       :language :ansi-c
-       :calling-convention :cdecl)
-    #+(and mcl (not openmcl))
+       #+:win32 :calling-convention #+:win32 :cdecl)
+    #+digitool
     `(eval-when (:compile-toplevel :load-toplevel :execute)
        (ccl:define-entry-point (,lisp-name ,foreign-name)
          ,function-args
@@ -117,10 +221,5 @@
     ))
 
 
-(defun make-lisp-name (name)
-  (let ((converted (substitute #\- #\_ name)))
-     (intern 
-      #+case-sensitive converted
-      #-case-sensitive (string-upcase converted))))
 
 

Modified: branches/xml-class-rework/thirdparty/uffi/src/libraries.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/src/libraries.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/src/libraries.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,13 +7,10 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: libraries.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 (in-package #:uffi)
@@ -23,9 +20,9 @@
 
 (defun default-foreign-library-type ()
   "Returns string naming default library type for platform"
-  #+(or win32 mswindows) "dll"
+  #+(or win32 cygwin mswindows) "dll"
   #+(or macosx darwin ccl-5.0) "dylib"
-  #-(or win32 mswindows macosx darwin ccl-5.0) "so"
+  #-(or win32 cygwin mswindows macosx darwin ccl-5.0) "so"
 )
 
 (defun foreign-library-types ()
@@ -35,7 +32,7 @@
   #-(or win32 mswindows macosx darwin ccl-5.0) '("so" "a" "o")
 )
 
-(defun find-foreign-library (names directories &key types drive-letters)  
+(defun find-foreign-library (names directories &key types drive-letters)
   "Looks for a foreign library. directories can be a single
 string or a list of strings of candidate directories. Use default
 library type if type is not specified."
@@ -56,21 +53,21 @@
     (dolist (name names)
       (dolist (dir directories)
 	(dolist (type types)
-	  (let ((path (make-pathname 
+	  (let ((path (make-pathname
 		       #+lispworks :host
 		       #+lispworks (when drive-letter drive-letter)
 		       #-lispworks :device
 		       #-lispworks (when drive-letter drive-letter)
-		       :name name 
+		       :name name
 		       :type type
-		       :directory 
+		       :directory
 		       (etypecase dir
 			 (pathname
 			  (pathname-directory dir))
 			 (list
 			  dir)
 			 (string
-			  (pathname-directory 
+			  (pathname-directory
 			   (parse-namestring dir)))))))
 	    (when (probe-file path)
 	      (return-from find-foreign-library path)))))))
@@ -79,13 +76,19 @@
 
 (defun load-foreign-library (filename &key module supporting-libraries
 					   force-load)
-  #+(or allegro mcl) (declare (ignore module supporting-libraries))
-  #+(or cmu scl sbcl) (declare (ignore module))
-  
-  (when (and filename (probe-file filename))
-    (if (pathnamep filename)    ;; ensure filename is a string to check if
-	(setq filename (namestring filename)))  ; already loaded
+  #+(or allegro openmcl digitool sbcl) (declare (ignore module supporting-libraries))
+  #+(or cmu scl) (declare (ignore module))
+  #+lispworks (declare (ignore supporting-libraries))
 
+  (when (and filename (or (null (pathname-directory filename))
+                          (probe-file filename)))
+    (if (pathnamep filename)    ;; ensure filename is a string to check if already loaded
+	(setq filename (namestring (if (null (pathname-directory filename))
+				       filename
+				       ;; lispworks treats as UNC, so use truename
+				       #+(and lispworks win32) (truename filename)
+				       #-(and lispworks win32) filename))))
+
     (if (and (not force-load)
 	     (find filename *loaded-libraries* :test #'string-equal))
 	t ;; return T, but don't reload library
@@ -94,31 +97,29 @@
 	(let ((type (pathname-type (parse-namestring filename))))
 	  (if (string-equal type "so")
 	      (sys::load-object-file filename)
-	      (alien:load-foreign filename 
+	      (alien:load-foreign filename
 				  :libraries
 				  (convert-supporting-libraries-to-string
 				   supporting-libraries))))
 	#+scl
 	(let ((type (pathname-type (parse-namestring filename))))
-	  (alien:load-foreign filename 
+	  (alien:load-foreign filename
 			      :libraries
 			      (convert-supporting-libraries-to-string
 			       supporting-libraries)))
 	#+sbcl
-	(let ((type (pathname-type (parse-namestring filename))))
-	  (if (or (string-equal type "so")
-		  (string-equal type "bundle")
-		  (string-equal type "dylib"))
-	      (sb-alien::load-1-foreign filename)
-	      (sb-alien:load-foreign filename 
-				     :libraries
-				     (convert-supporting-libraries-to-string
-				      supporting-libraries))))
-	#+lispworks (fli:register-module module :real-name filename)
+	(handler-case (sb-alien::load-1-foreign filename)
+	  (sb-int:unsupported-operator (c)
+	    (if (fboundp (intern "LOAD-SHARED-OBJECT" :sb-alien))
+		(funcall (intern "LOAD-SHARED-OBJECT" :sb-alien) filename)
+		(error c))))
+
+	#+lispworks (fli:register-module module :real-name filename
+                                                :connection-style :immediate)
 	#+allegro (load filename)
 	#+openmcl (ccl:open-shared-library filename)
-	#+(and mcl (not openmcl)) (ccl:add-to-shared-library-search-path filename t)
-	
+	#+digitool (ccl:add-to-shared-library-search-path filename t)
+
 	(push filename *loaded-libraries*)
 	t))))
 

Modified: branches/xml-class-rework/thirdparty/uffi/src/objects.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/src/objects.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/src/objects.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,32 +7,29 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: objects.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 (in-package #:uffi)
 
-(defun size-of-foreign-type (type)
-  #+lispworks (fli:size-of type)
-  #+allegro (ff:sizeof-fobject type)
-  #+(or cmu scl)  (ash (eval `(alien:alien-size ,type)) -3) ;; convert from bits to bytes
-  #+sbcl  (ash (eval `(sb-alien:alien-size ,type)) -3) ;; convert from bits to bytes
-  #+clisp (values (ffi:size-of type))
-  #+(and mcl (not openmcl))
-  (let ((mcl-type (ccl:find-mactype type nil t)))
-    (if mcl-type 
-	(ccl::mactype-record-size mcl-type)
-      (ccl::record-descriptor-length (ccl:find-record-descriptor type t t)))) ;error if not a record
-  #+openmcl (ccl::%foreign-type-or-record-size type :bytes)
-  )
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun size-of-foreign-type (type)
+    #+lispworks (fli:size-of type)
+    #+allegro (ff:sizeof-fobject type)
+    #+(or cmu scl)  (ash (eval `(alien:alien-size ,type)) -3) ;; convert from bits to bytes
+    #+sbcl  (ash (eval `(sb-alien:alien-size ,type)) -3) ;; convert from bits to bytes
+    #+clisp (values (ffi:size-of type))
+    #+digitool
+    (let ((mcl-type (ccl:find-mactype type nil t)))
+      (if mcl-type
+	  (ccl::mactype-record-size mcl-type)
+	  (ccl::record-descriptor-length (ccl:find-record-descriptor type t t)))) ;error if not a record
+    #+openmcl (ccl::%foreign-type-or-record-size type :bytes)
+    ))
 
-
 (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. The TYPE parameter is evaluated."
@@ -46,7 +43,7 @@
 	`(fli:allocate-foreign-object :type ',(convert-from-uffi-type type :allocate))
 	#+allegro
 	`(ff:allocate-fobject ',(convert-from-uffi-type type :allocate) :c)
-	#+mcl
+	#+(or openmcl digitool)
 	`(new-ptr ,(size-of-foreign-type (convert-from-uffi-type type :allocation)))
 	)
       (progn
@@ -58,7 +55,7 @@
 	`(fli:allocate-foreign-object :type ',(convert-from-uffi-type type :allocate) :nelems ,size)
 	#+allegro
 	`(ff:allocate-fobject (list :array (quote ,(convert-from-uffi-type type :allocate)) ,size) :c)
-	#+mcl
+	#+(or openmcl digitool)
 	`(new-ptr (* ,size ,(size-of-foreign-type (convert-from-uffi-type type :allocation))))
 	)))
 
@@ -71,7 +68,7 @@
   `(fli:free-foreign-object ,obj)
   #+allegro
   `(ff:free-fobject ,obj)
-  #+mcl
+  #+(or openmcl digitool)
   `(dispose-ptr ,obj)
   )
 
@@ -80,25 +77,35 @@
   #+allegro `(zerop ,obj)
   #+(or cmu scl)   `(alien:null-alien ,obj)
   #+sbcl   `(sb-alien:null-alien ,obj)
-  #+mcl   `(ccl:%null-ptr-p ,obj)
+  #+(or openmcl digitool)   `(ccl:%null-ptr-p ,obj)
   )
 
 (defmacro make-null-pointer (type)
-  #+(or allegro mcl) (declare (ignore type))
+  #+(or allegro openmcl digitool) (declare (ignore type))
   #+(or cmu scl) `(alien:sap-alien (system:int-sap 0) (* ,(convert-from-uffi-type (eval type) :type)))
   #+sbcl `(sb-alien:sap-alien (sb-sys:int-sap 0) (* ,(convert-from-uffi-type (eval type) :type)))
   #+lispworks `(fli:make-pointer :address 0 :type (quote ,(convert-from-uffi-type (eval type) :type)))
   #+allegro 0
-  #+mcl `(ccl:%null-ptr)
+  #+(or openmcl digitool) `(ccl:%null-ptr)
   )
 
+(defmacro make-pointer (addr type)
+  #+(or allegro openmcl digitool) (declare (ignore type))
+  #+(or cmu scl) `(alien:sap-alien (system:int-sap ,addr) (* ,(convert-from-uffi-type (eval type) :type)))
+  #+sbcl `(sb-alien:sap-alien (sb-sys:int-sap ,addr) (* ,(convert-from-uffi-type (eval type) :type)))
+  #+lispworks `(fli:make-pointer :address ,addr :type (quote ,(convert-from-uffi-type (eval type) :type)))
+  #+allegro addr
+  #+(or openmcl digitool) `(ccl:%int-to-ptr ,addr)
+  )
+
+
 (defmacro char-array-to-pointer (obj)
   #+(or cmu scl) `(alien:cast ,obj (* (alien:unsigned 8)))
   #+sbcl `(sb-alien:cast ,obj (* (sb-alien:unsigned 8)))
   #+lispworks `(fli:make-pointer :type '(:unsigned :char)
 				:address (fli:pointer-address ,obj))
   #+allegro obj
-  #+mcl obj
+  #+(or openmcl digitool) obj
   )
 
 (defmacro deref-pointer (ptr type)
@@ -108,35 +115,33 @@
   #+sbcl  `(sb-alien:deref ,ptr)
   #+lispworks `(fli:dereference ,ptr)
   #+allegro `(ff:fslot-value-typed (quote ,(convert-from-uffi-type type :deref)) :c ,ptr)
-  #+mcl `(ccl:pref ,ptr ,(convert-from-uffi-type type :deref))
+  #+(or openmcl digitool) `(ccl:pref ,ptr ,(convert-from-uffi-type type :deref))
   )
 
-#+mcl
+#+digitool
 (defmacro deref-pointer-set (ptr type value)
   `(setf (ccl:pref ,ptr ,(convert-from-uffi-type type :deref)) ,value))
 
-#+mcl
+#+digitool
 (defsetf deref-pointer deref-pointer-set)
 
-#+lispworks
 (defmacro ensure-char-character (obj)
-  `(if (characterp ,obj) ,obj (code-char ,obj)))
+  #+(or digitool) obj
+  #+(or allegro cmu sbcl scl openmcl) `(code-char ,obj)
+  ;; lispworks varies whether deref'ing array vs. slot access of a char
+  #+lispworks `(if (characterp ,obj) ,obj (code-char ,obj)))
 
-#+(and mcl (not openmcl)) 
-(defmacro ensure-char-character (obj)
-  obj)
-
-#+(or allegro cmu sbcl scl openmcl)
-(defmacro ensure-char-character (obj)
-  `(code-char ,obj))
-  
-#+(or lispworks (and mcl (not openmcl)))
 (defmacro ensure-char-integer (obj)
- `(char-code ,obj))
+  #+(or digitool) `(char-code ,obj)
+  #+(or allegro cmu sbcl scl openmcl) obj
+  ;; lispworks varies whether deref'ing array vs. slot access of a char
+  #+lispworks
+  `(if (integerp ,obj) ,obj (char-code ,obj)))
 
-#+(or allegro cmu sbcl scl openmcl)
-(defmacro ensure-char-integer (obj)
-  obj)
+(defmacro ensure-char-storable (obj)
+  #+(or digitool (and lispworks (not lispworks5))) obj
+  #+(or allegro cmu lispworks5 openmcl sbcl scl)
+  `(char-code ,obj))
 
 (defmacro pointer-address (obj)
   #+(or cmu scl)
@@ -147,12 +152,12 @@
   `(fli:pointer-address ,obj)
   #+allegro
   obj
-  #+mcl
-  `(ccl:%ptr-to-int ,obj)  
+  #+(or openmcl digitool)
+  `(ccl:%ptr-to-int ,obj)
   )
 
 ;; TYPE is evaluated.
-#-mcl
+#-(or openmcl digitool)
 (defmacro with-foreign-object ((var type) &rest body)
   #-(or cmu sbcl lispworks scl) ; default version
   `(let ((,var (allocate-foreign-object ,type)))
@@ -160,22 +165,32 @@
 	 (progn , at body)
       (free-foreign-object ,var)))
   #+(or cmu scl)
-  (let ((obj (gensym)))
-    `(alien:with-alien ((,obj ,(convert-from-uffi-type (eval type) :allocate)))
-       (let ((,var (alien:addr ,obj)))
-	 , at body)))
+  (let ((obj (gensym))
+	(ctype (convert-from-uffi-type (eval type) :allocate)))
+    (if (and (consp ctype) (eq 'array (car ctype)))
+	`(alien:with-alien ((,obj ,ctype))
+	  (let* ((,var ,obj))
+	    , at body))
+	`(alien:with-alien ((,obj ,ctype))
+	  (let* ((,var (alien:addr ,obj)))
+	    , at body))))
   #+sbcl
-  (let ((obj (gensym)))
-    `(sb-alien:with-alien ((,obj ,(convert-from-uffi-type (eval type) :allocate)))
-       (let ((,var (sb-alien:addr ,obj)))
-	 , at body)))
+  (let ((obj (gensym))
+	(ctype (convert-from-uffi-type (eval type) :allocate)))
+    (if (and (consp ctype) (eq 'array (car ctype)))
+	`(sb-alien:with-alien ((,obj ,ctype))
+	  (let* ((,var ,obj))
+	    , at body))
+	`(sb-alien:with-alien ((,obj ,ctype))
+	  (let* ((,var (sb-alien:addr ,obj)))
+	    , at body))))
   #+lispworks
   `(fli:with-dynamic-foreign-objects ((,var ,(convert-from-uffi-type
 					      (eval type) :allocate)))
     , at body)
   )
 
-#-mcl
+#-(or openmcl digitool)
 (defmacro with-foreign-objects (bindings &rest body)
   (if bindings
       `(with-foreign-object ,(car bindings)
@@ -183,7 +198,7 @@
 	  , at body))
       `(progn , at body)))
 
-#+mcl
+#+(or openmcl digitool)
 (defmacro with-foreign-objects (bindings &rest body)
   (let ((params nil) type count)
     (dolist (spec (reverse bindings)) ;keep order - macroexpands to let*
@@ -195,10 +210,10 @@
         (setf type (nth 1 type)))
       (push (list (first spec) (* count (size-of-foreign-type type))) params))
     `(ccl:%stack-block ,params , at body)))
-				 
-#+mcl
+
+#+(or openmcl digitool)
 (defmacro with-foreign-object ((var type) &rest body)
-  `(with-foreign-objects ((,var ,type)) 
+  `(with-foreign-objects ((,var ,type))
      , at body))
 
 #+lispworks
@@ -216,18 +231,24 @@
            ,pointer (* ,(convert-from-uffi-type (eval type) :type)))))
     , at body))
 
-#+allegro
+#+(or allegro openmcl)
 (defmacro with-cast-pointer ((binding-name pointer type) &body body)
   (declare (ignore type))
   `(let ((,binding-name ,pointer))
     , at body))
 
-#-(or lispworks cmu scl sbcl allegro)
+#-(or lispworks cmu scl sbcl allegro openmcl)
 (defmacro with-cast-pointer ((binding-name pointer type) &body body)
-  (declare (ignore binding-name pointer type))
+  (declare (ignore binding-name pointer type body))
   '(error "WITH-CAST-POINTER not (yet) implemented for ~A"
           (lisp-implementation-type)))
 
+#+(or allegro openmcl)
+(defun convert-external-name (name)
+  "Add an underscore to NAME if necessary for the ABI."
+  #+(or macosx darwinppc-target) (concatenate 'string "_" name)
+  #-(or macosx darwinppc-target) name)
+
 (defmacro def-foreign-var (names type module)
   #-lispworks (declare (ignore module))
   (let ((foreign-name (if (atom names) names (first names)))
@@ -241,7 +262,7 @@
     #+allegro
     `(define-symbol-macro ,lisp-name
       (ff:fslot-value-typed (quote ,(convert-from-uffi-type type :deref))
-                            :c (ff:get-entry-point ,foreign-name)))
+                            :c (ff:get-entry-point ,(convert-external-name foreign-name))))
     #+lispworks
     `(progn
       (fli:define-foreign-variable (,lisp-name ,foreign-name)
@@ -250,7 +271,21 @@
                                     :module ,module)
       (define-symbol-macro ,lisp-name (fli:dereference (,lisp-name)
                                                         :copy-foreign-object nil)))
-    #-(or allegro cmu scl sbcl lispworks)
+    #+openmcl
     `(define-symbol-macro ,lisp-name
+       (deref-pointer (ccl:foreign-symbol-address
+                       ,(convert-external-name foreign-name)) ,var-type))
+    #-(or allegro cmu scl sbcl lispworks openmcl)
+    `(define-symbol-macro ,lisp-name
       '(error "DEF-FOREIGN-VAR not (yet) defined for ~A"
         (lisp-implementation-type)))))
+
+
+;;; Define a special variable, like DEFVAR, that will be initialized
+;;; to a pointer which may need to be reset when a saved image is
+;;; loaded.  This is needed for OpenMCL, which sets pointers to "dead
+;;; macptrs" when a saved image is loaded.
+;; This may possibly be needed for sbcl's SAVE-LISP-AND-DIE
+(defmacro def-pointer-var (name value &optional doc)
+  #-openmcl `(defvar ,name ,value ,@(if doc (list doc)))
+  #+openmcl `(ccl::defloadvar ,name ,value ,doc))

Modified: branches/xml-class-rework/thirdparty/uffi/src/os.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/src/os.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/src/os.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -5,21 +5,32 @@
 ;;;; Name:          os.lisp
 ;;;; Purpose:       Operating system interface for UFFI
 ;;;; Programmer:    Kevin M. Rosenberg
-;;;; Date Started:  Sep 2002 
+;;;; Date Started:  Sep 2002
 ;;;;
-;;;; $Id: os.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; 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
-;;;; for that code is noted below where appropriate.
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg.
 ;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 (in-package #:uffi)
 
+
+(defun getenv (var)
+  "Return the value of the environment variable."
+  #+allegro (sys::getenv (string var))
+  #+clisp (sys::getenv (string var))
+  #+cmu (cdr (assoc (string var) ext:*environment-list* :test #'equalp
+                    :key #'string))
+  #+gcl (si:getenv (string var))
+  #+lispworks (lw:environment-variable (string var))
+  #+lucid (lcl:environment-variable (string var))
+  #+(or openmcl digitool) (ccl::getenv var)
+  #+sbcl (sb-ext:posix-getenv var)
+  #-(or allegro clisp cmu gcl lispworks lucid openmcl digitool sbcl)
+  (error 'not-implemented :proc (list 'getenv var)))
+
+
 ;; modified from function ASDF -- Copyright Dan Barlow and Contributors
 
 (defun run-shell-command (control-string  &rest args &key output)
@@ -32,27 +43,27 @@
   (let ((command (apply #'format nil control-string args)))
     #+sbcl
     (sb-impl::process-exit-code
-     (sb-ext:run-program  
+     (sb-ext:run-program
       "/bin/sh"
       (list "-c" command)
       :input nil :output output))
-    
+
     #+(or cmu scl)
     (ext:process-exit-code
-     (ext:run-program  
+     (ext:run-program
       "/bin/sh"
       (list "-c" command)
       :input nil :output output))
 
     #+allegro
     (excl:run-shell-command command :input nil :output output)
-    
+
     #+lispworks
     (system:call-system-showing-output
      command
      :shell-type "/bin/sh"
      :output-stream output)
-    
+
     #+clisp				;XXX not exactly *trace-output*, I know
     (ext:run-shell-command  command :output :terminal :wait t)
 
@@ -64,5 +75,5 @@
 				 :wait t)))
 
     #-(or openmcl clisp lispworks allegro scl cmu sbcl)
-    (error "RUN-SHELL-PROGRAM not implemented for this Lisp")
+    (error "RUN-SHELL-PROGRAM not implemented for this Lisp.")
     ))

Modified: branches/xml-class-rework/thirdparty/uffi/src/package.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/src/package.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/src/package.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,25 +7,22 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 (in-package #:cl-user)
 
 (defpackage #:uffi
   (:use #:cl)
-  (:export 
-   
+  (:export
+
    ;; immediate types
    #:def-constant
    #:def-foreign-type
    #:def-type
    #:null-char-p
-   
+
    ;; aggregate types
    #:def-enum
    #:def-struct
@@ -34,7 +31,7 @@
    #:def-array-pointer
    #:deref-array
    #:def-union
-   
+
    ;; objects
    #:allocate-foreign-object
    #:free-foreign-object
@@ -45,13 +42,18 @@
    #:deref-pointer
    #:ensure-char-character
    #:ensure-char-integer
+   #:ensure-char-storable
    #:null-pointer-p
    #:make-null-pointer
+   #:make-pointer
+   #:pointer-address
    #:+null-cstring-pointer+
    #:char-array-to-pointer
    #:with-cast-pointer
    #:def-foreign-var
-   
+   #:convert-from-foreign-usb8
+   #:def-pointer-var
+
    ;; string functions
    #:convert-from-cstring
    #:convert-to-cstring
@@ -62,7 +64,9 @@
    #:convert-to-foreign-string
    #:allocate-foreign-string
    #:with-foreign-string
-   
+   #:with-foreign-strings
+   #:foreign-string-length
+
    ;; function call
    #:def-function
 
@@ -70,9 +74,11 @@
    #:find-foreign-library
    #:load-foreign-library
    #:default-foreign-library-type
+   #:foreign-library-types
 
    ;; OS
    #:run-shell-command
+   #:getenv
    ))
 
 

Modified: branches/xml-class-rework/thirdparty/uffi/src/primitives.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/src/primitives.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/src/primitives.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,21 +7,18 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: primitives.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 (in-package #:uffi)
 
-#+mcl
+#+(or openmcl digitool)
 (defvar *keyword-package* (find-package "KEYWORD"))
 
-#+mcl
+#+(or openmcl digitool)
 ; MCL and OpenMCL expect a lot of FFI elements to be keywords (e.g. struct field names in OpenMCL)
 ; So this provides a function to convert any quoted symbols to keywords.
 (defun keyword (obj)
@@ -39,7 +36,7 @@
          obj)))
 
 ; Wrapper for unexported function we have to use
-#+(and mcl (not openmcl))
+#+digitool
 (defmacro def-mcl-type (name type)
   `(ccl::def-mactype ,(keyword name) (ccl:find-mactype ,type)))
 
@@ -53,8 +50,8 @@
 (defmacro def-type (name type)
   "Generates a (deftype) statement for CL. Currently, only CMUCL
 supports takes advantage of this optimization."
-  #+(or lispworks allegro mcl cormanlisp)  (declare (ignore type))
-  #+(or lispworks allegro mcl cormanlisp) `(deftype ,name () t)
+  #+(or lispworks allegro openmcl digitool cormanlisp)  (declare (ignore type))
+  #+(or lispworks allegro openmcl digitool cormanlisp) `(deftype ,name () t)
   #+(or cmu scl)
   `(deftype ,name () '(alien:alien ,(convert-from-uffi-type type :declare)))
   #+sbcl
@@ -71,11 +68,11 @@
   #+(or cmu scl) `(alien:def-alien-type ,name ,(convert-from-uffi-type type :type))
   #+sbcl `(sb-alien:define-alien-type ,name ,(convert-from-uffi-type type :type))
   #+cormanlisp `(ct:defctype ,name ,(convert-from-uffi-type type :type))
-  #+mcl
+  #+(or openmcl digitool)
   (let ((mcl-type (convert-from-uffi-type type :type)))
     (unless (or (keywordp mcl-type) (consp mcl-type))
       (setf mcl-type `(quote ,mcl-type)))
-    #+(and mcl (not openmcl))
+    #+digitool
     `(def-mcl-type ,(keyword name) ,mcl-type)
     #+openmcl
     `(ccl::def-foreign-type ,(keyword name) ,mcl-type))  
@@ -87,9 +84,6 @@
 			(make-hash-table :size 20 :test #'eq))
   )
 
-#+(or cmu sbcl scl)
-(defvar *cmu-sbcl-def-type-list* nil)
-
 #+(or cmu scl)
 (defvar *cmu-sbcl-def-type-list*
     '((:char . (alien:signed 8))
@@ -100,12 +94,16 @@
       (:unsigned-short . (alien:unsigned 16))
       (:int . (alien:signed 32))
       (:unsigned-int . (alien:unsigned 32))
-      (:long . (alien:signed 32))
-      (:unsigned-long . (alien:unsigned 32))
+      #-x86-64 (:long . (alien:signed 32))
+      #-x86-64 (:unsigned-long . (alien:unsigned 32))
+      #+x86-64 (:long . (alien:signed 64))
+      #+x86-64 (:unsigned-long . (alien:unsigned 64))
       (:float . alien:single-float)
       (:double . alien:double-float)
+      (:void . t)
       )
   "Conversions in CMUCL for def-foreign-type are different than in def-function")
+
 #+sbcl
 (defvar *cmu-sbcl-def-type-list*
     '((:char . (sb-alien:signed 8))
@@ -116,10 +114,13 @@
       (:unsigned-short . (sb-alien:unsigned 16))
       (:int . (sb-alien:signed 32))
       (:unsigned-int . (sb-alien:unsigned 32))
-      (:long . (sb-alien:signed 32))
-      (:unsigned-long . (sb-alien:unsigned 32))
+      #-x86-64 (:long . (sb-alien:signed 32))
+      #-x86-64 (:unsigned-long . (sb-alien:unsigned 32))
+      #+x86-64 (:long . (sb-alien:signed 64))
+      #+x86-64 (:unsigned-long . (sb-alien:unsigned 64))
       (:float . sb-alien:single-float)
       (:double . sb-alien:double-float)
+      (:void . t)
       )
   "Conversions in SBCL for def-foreign-type are different than in def-function")
 
@@ -145,14 +146,15 @@
 (setq *type-conversion-list*
     '((* . *) (:void . sb-alien:void) 
       (:pointer-void . (* t))
-      (:cstring . sb-alien:c-string)
+      #-sb-unicode(:cstring . sb-alien:c-string)
+      #+sb-unicode(:cstring . sb-alien:utf8-string)
       (:char . sb-alien:char) 
       (:unsigned-char . (sb-alien:unsigned 8))
       (:byte . (sb-alien:signed 8))
       (:unsigned-byte . (sb-alien:unsigned 8))
       (:short . sb-alien:short)
       (:unsigned-short . sb-alien:unsigned-short)
-      (:int . sb-alien:integer) (:unsigned-int . sb-alien:unsigned-int) 
+      (:int . sb-alien:int) (:unsigned-int . sb-alien:unsigned-int) 
       (:long . sb-alien:long) (:unsigned-long . sb-alien:unsigned-long)
       (:float . sb-alien:float) (:double . sb-alien:double)
       (:array . sb-alien:array)))
@@ -192,7 +194,7 @@
       (:float . :float) (:double . :double)
       (:array . :c-array)))
 
-#+(and mcl (not openmcl))
+#+digitool
 (setq *type-conversion-list*
      '((* . :pointer) (:void . :void)
        (:short . :short) (:unsigned-short . :unsigned-short)
@@ -232,8 +234,8 @@
   (let ((found-type (gethash type +type-conversion-hash+)))
     (if found-type
 	found-type
-      #-mcl type
-      #+mcl (keyword type))))
+      #-(or openmcl digitool) type
+      #+(or openmcl digitool) (keyword type))))
 
 (defun %convert-from-uffi-type (type context)
   "Converts from a uffi type to an implementation specific type"
@@ -253,7 +255,7 @@
        ((and (eq context :return)
 	     (eq type :cstring))
 	(basic-convert-from-uffi-type :cstring-returning))
-       #+(and mcl (not openmcl))
+       #+digitool
        ((and (eq type :void) (eq context :return)) nil)
        (t
 	(basic-convert-from-uffi-type type)))
@@ -262,16 +264,20 @@
 	(cl:quote
 	 (convert-from-uffi-type (cadr type) context))
 	(:struct-pointer
-	 #+mcl `(:* (:struct ,(%convert-from-uffi-type (cadr type) :struct)))
-	 #-mcl (%convert-from-uffi-type (list '* (cadr type)) :struct)
+	 #+(or openmcl digitool) `(:* (:struct ,(%convert-from-uffi-type (cadr type) :struct)))
+	 #-(or openmcl digitool) (%convert-from-uffi-type (list '* (cadr type)) :struct)
 	 )
 	(:struct
-	 #+mcl `(:struct ,(%convert-from-uffi-type (cadr type) :struct))
-	 #-mcl (%convert-from-uffi-type (cadr type) :struct)
+	 #+(or openmcl digitool) `(:struct ,(%convert-from-uffi-type (cadr type) :struct))
+	 #-(or openmcl digitool) (%convert-from-uffi-type (cadr type) :struct)
 	 )
-	(t
-	 (cons (%convert-from-uffi-type (first type) context) 
-	       (%convert-from-uffi-type (rest type) context)))))))
+       (:union
+	#+(or openmcl digitool) `(:union ,(%convert-from-uffi-type (cadr type) :union))
+	#-(or openmcl digitool) (%convert-from-uffi-type (cadr type) :union)
+	)
+       (t
+	(cons (%convert-from-uffi-type (first type) context) 
+	      (%convert-from-uffi-type (rest type) context)))))))
 
 (defun convert-from-uffi-type (type context)
   (let ((result (%convert-from-uffi-type type context)))
@@ -282,7 +288,24 @@
       (if (eq context :struct)
 	  (append '(:*) (cdr result))
 	:address))
-     #+(and mcl (not openmcl))
+     #+digitool
      ((and (eq (car result) :pointer) (eq context :allocation) :pointer))
      (t result))))
 
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (when (char= #\a (schar (symbol-name '#:a) 0))
+    (pushnew :uffi-lowercase-reader *features*))
+  (when (not (string= (symbol-name '#:a)
+		      (symbol-name '#:A)))
+    (pushnew :uffi-case-sensitive *features*)))
+
+(defun make-lisp-name (name)
+  (let ((converted (substitute #\- #\_ name)))
+     (intern 
+      #+uffi-case-sensitive converted
+      #+(and (not uffi-lowercase-reader) (not uffi-case-sensitive)) (string-upcase converted)
+      #+(and uffi-lowercase-reader (not uffi-case-sensitive)) (string-downcase converted))))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setq cl:*features* (delete :uffi-lowercase-reader *features*))
+  (setq cl:*features* (delete :uffi-case-sensitive *features*)))

Modified: branches/xml-class-rework/thirdparty/uffi/src/readmacros-mcl.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/src/readmacros-mcl.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/src/readmacros-mcl.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,24 +7,21 @@
 ;;;; Programmer:    Kevin M. Rosenberg/John Desoi
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: readmacros-mcl.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 (in-package #:uffi)
 
 
 ;; trap macros don't work right directly in the macros
-#+(and mcl (not openmcl))
+#+digitool
 (defun new-ptr (size)
   (#_NewPtr size))
 
-#+(and mcl (not openmcl))
+#+digitool
 (defun dispose-ptr (ptr)
   (#_DisposePtr ptr))
 

Modified: branches/xml-class-rework/thirdparty/uffi/src/strings.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/src/strings.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/src/strings.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,36 +7,32 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: strings.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;; *************************************************************************
 
 (in-package #:uffi)
 
 
-(defvar +null-cstring-pointer+
+(def-pointer-var +null-cstring-pointer+
     #+(or cmu sbcl scl) nil
     #+allegro 0
     #+lispworks (fli:make-pointer :address 0 :type '(:unsigned :char))
-    #+mcl (ccl:%null-ptr)
+    #+(or openmcl digitool) (ccl:%null-ptr)
 )
 
 (defmacro convert-from-cstring (obj)
   "Converts a string from a c-call. Same as convert-from-foreign-string, except
 that LW/CMU automatically converts strings from c-calls."
   #+(or cmu sbcl lispworks scl) obj
-  #+allegro 
+  #+allegro
   (let ((stored (gensym)))
     `(let ((,stored ,obj))
        (if (zerop ,stored)
 	   nil
-	 (values (excl:native-to-string ,stored)))))
-  #+mcl 
+	   (values (excl:native-to-string ,stored)))))
+  #+(or openmcl digitool)
   (let ((stored (gensym)))
     `(let ((,stored ,obj))
        (if (ccl:%null-ptr-p ,stored)
@@ -47,41 +43,53 @@
 (defmacro convert-to-cstring (obj)
   #+(or cmu sbcl scl lispworks) obj
   #+allegro
-  `(if (null ,obj)
-    0
-    (values (excl:string-to-native ,obj)))
-  #+mcl
-  `(if (null ,obj)
-    +null-cstring-pointer+
-    (let ((ptr (new-ptr (1+ (length ,obj)))))
-      (ccl::%put-cstring ptr ,obj)
-      ptr))
+  (let ((stored (gensym)))
+    `(let ((,stored ,obj))
+       (if (null ,stored)
+	   0
+	   (values (excl:string-to-native ,stored)))))
+  #+(or openmcl digitool)
+  (let ((stored (gensym)))
+    `(let ((,stored ,obj))
+       (if (null ,stored)
+	   +null-cstring-pointer+
+	   (let ((ptr (new-ptr (1+ (length ,stored)))))
+	     (ccl::%put-cstring ptr ,stored)
+	     ptr))))
   )
 
 (defmacro free-cstring (obj)
   #+(or cmu sbcl scl lispworks) (declare (ignore obj))
   #+allegro
-  `(unless (zerop ,obj)
-     (ff:free-fobject ,obj))
-  #+mcl
-  `(unless (ccl:%null-ptr-p ,obj)
-     (dispose-ptr ,obj))
+  (let ((stored (gensym)))
+    `(let ((,stored ,obj))
+       (unless (zerop ,stored)
+	 (ff:free-fobject ,stored))))
+  #+(or openmcl digitool)
+  (let ((stored (gensym)))
+    `(let ((,stored ,obj))
+       (unless (ccl:%null-ptr-p ,stored)
+	 (dispose-ptr ,stored))))
   )
 
 (defmacro with-cstring ((cstring lisp-string) &body body)
   #+(or cmu sbcl scl lispworks)
-  `(let ((,cstring ,lisp-string)) , at body) 
+  `(let ((,cstring ,lisp-string)) , at body)
   #+allegro
-  (let ((acl-native (gensym)))
-    `(excl:with-native-string (,acl-native ,lisp-string)
-       (let ((,cstring (if ,lisp-string ,acl-native 0)))
-	 , at body)))
-  #+mcl
-  `(if (stringp ,lisp-string)
-     (ccl:with-cstrs ((,cstring ,lisp-string))
-       , at body)
-     (let ((,cstring +null-cstring-pointer+))
-       , at body))
+  (let ((acl-native (gensym))
+	(stored-lisp-string (gensym)))
+    `(let ((,stored-lisp-string ,lisp-string))
+       (excl:with-native-string (,acl-native ,stored-lisp-string)
+	 (let ((,cstring (if ,stored-lisp-string ,acl-native 0)))
+	   , at body))))
+  #+(or openmcl digitool)
+  (let ((stored-lisp-string (gensym)))
+    `(let ((,stored-lisp-string ,lisp-string))
+       (if (stringp ,stored-lisp-string)
+	   (ccl:with-cstrs ((,cstring ,stored-lisp-string))
+	     , at body)
+	   (let ((,cstring +null-cstring-pointer+))
+	     , at body))))
   )
 
 (defmacro with-cstrings (bindings &rest body)
@@ -95,134 +103,179 @@
 
 (defmacro convert-to-foreign-string (obj)
   #+lispworks
-  `(if (null ,obj)
-    +null-cstring-pointer+
-    (fli:convert-to-foreign-string ,obj :external-format '(:latin-1 :eol-style :lf)))
+  (let ((stored (gensym)))
+    `(let ((,stored ,obj))
+       (if (null ,stored)
+	   +null-cstring-pointer+
+	   (fli:convert-to-foreign-string
+	    ,stored
+	    :external-format '(:latin-1 :eol-style :lf)))))
   #+allegro
-  `(if (null ,obj)
-       0
-     (values (excl:string-to-native ,obj)))
+  (let ((stored (gensym)))
+    `(let ((,stored ,obj))
+       (if (null ,stored)
+	   0
+	   (values (excl:string-to-native ,stored)))))
   #+(or cmu scl)
   (let ((size (gensym))
 	(storage (gensym))
+	(stored-obj (gensym))
 	(i (gensym)))
-    `(etypecase ,obj
-      (null 
-       (alien:sap-alien (system:int-sap 0) (* (alien:unsigned 8))))
-      (string
-       (let* ((,size (length ,obj))
-	      (,storage (alien:make-alien (alien:unsigned 8) (1+ ,size))))
-	 (setq ,storage (alien:cast ,storage (* (alien:unsigned 8))))
-	 (locally
-	     (declare (optimize (speed 3) (safety 0)))
-	   (dotimes (,i ,size)
-	     (declare (fixnum ,i))
-	     (setf (alien:deref ,storage ,i) (char-code (char ,obj ,i))))
+    `(let ((,stored-obj ,obj))
+       (etypecase ,stored-obj
+	 (null
+	  (alien:sap-alien (system:int-sap 0) (* (alien:unsigned 8))))
+	 (string
+	  (let* ((,size (length ,stored-obj))
+		 (,storage (alien:make-alien (alien:unsigned 8) (1+ ,size))))
+	    (setq ,storage (alien:cast ,storage (* (alien:unsigned 8))))
+	    (locally
+		(declare (optimize (speed 3) (safety 0)))
+	      (dotimes (,i ,size)
+		(declare (fixnum ,i))
+		(setf (alien:deref ,storage ,i)
+		      (char-code (char ,stored-obj ,i))))
 	   (setf (alien:deref ,storage ,size) 0))
-	 ,storage))))
+	 ,storage)))))
   #+sbcl
   (let ((size (gensym))
 	(storage (gensym))
+	(stored-obj (gensym))
 	(i (gensym)))
-    `(etypecase ,obj
-      (null 
-       (sb-alien:sap-alien (sb-sys:int-sap 0) (* (sb-alien:unsigned 8))))
-      (string
-       (let* ((,size (length ,obj))
-	      (,storage (sb-alien:make-alien (sb-alien:unsigned 8) (1+ ,size))))
-	 (setq ,storage (sb-alien:cast ,storage (* (sb-alien:unsigned 8))))
-	 (locally
-	     (declare (optimize (speed 3) (safety 0)))
-	   (dotimes (,i ,size)
-	     (declare (fixnum ,i))
-	     (setf (sb-alien:deref ,storage ,i) (char-code (char ,obj ,i))))
-	   (setf (sb-alien:deref ,storage ,size) 0))
-	 ,storage))))
-  #+mcl
-  `(if (null ,obj)
-       +null-cstring-pointer+
-     (let ((ptr (new-ptr (1+ (length ,obj)))))
-       (ccl::%put-cstring ptr ,obj)
-       ptr))
+    `(let ((,stored-obj ,obj))
+       (etypecase ,stored-obj
+	 (null
+	  (sb-alien:sap-alien (sb-sys:int-sap 0) (* (sb-alien:unsigned 8))))
+	 (string
+	  (let* ((,size (length ,stored-obj))
+		 (,storage (sb-alien:make-alien (sb-alien:unsigned 8) (1+ ,size))))
+	    (setq ,storage (sb-alien:cast ,storage (* (sb-alien:unsigned 8))))
+	    (locally
+		(declare (optimize (speed 3) (safety 0)))
+	      (dotimes (,i ,size)
+		(declare (fixnum ,i))
+		(setf (sb-alien:deref ,storage ,i)
+		      (char-code (char ,stored-obj ,i))))
+	      (setf (sb-alien:deref ,storage ,size) 0))
+	    ,storage)))))
+  #+(or openmcl digitool)
+  (let ((stored-obj (gensym)))
+    `(let ((,stored-obj ,obj))
+       (if (null ,stored-obj)
+	   +null-cstring-pointer+
+	   (let ((ptr (new-ptr (1+ (length ,stored-obj)))))
+	     (ccl::%put-cstring ptr ,stored-obj)
+	     ptr))))
   )
 
-
 ;; 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
-     (if (eq ,locale :none)
-	 (fast-native-to-string ,obj ,length)
-       (excl:native-to-string
-	,obj 
-	,@(when length (list :length length))
-	:truncate (not ,null-terminated-p))))
+  (let ((stored-obj (gensym)))
+    `(let ((,stored-obj ,obj))
+       (if (zerop ,stored-obj)
+	   nil
+	   (if (eq ,locale :none)
+	       (fast-native-to-string ,stored-obj ,length)
+	       (values
+		(excl:native-to-string
+		 ,stored-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 ,length)
-       (fli:convert-from-foreign-string 
-	,obj
-	,@(when length (list :length length))
-	:null-terminated-p ,null-terminated-p
-	:external-format '(:latin-1 :eol-style :lf))))
+  (let ((stored-obj (gensym)))
+    `(let ((,stored-obj ,obj))
+       (if (fli:null-pointer-p ,stored-obj)
+	   nil
+	   (if (eq ,locale :none)
+	       (fast-native-to-string ,stored-obj ,length)
+	       (fli:convert-from-foreign-string
+		,stored-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
-    (cmucl-naturalize-cstring (alien:alien-sap ,obj)
-     :length ,length
-     :null-terminated-p ,null-terminated-p))
+  (let ((stored-obj (gensym)))
+    `(let ((,stored-obj ,obj))
+       (if (null-pointer-p ,stored-obj)
+	   nil
+	   (cmucl-naturalize-cstring (alien:alien-sap ,stored-obj)
+				     :length ,length
+				     :null-terminated-p ,null-terminated-p))))
+
   #+sbcl
-  `(if (null-pointer-p ,obj)
-    nil
-    (sbcl-naturalize-cstring (sb-alien:alien-sap ,obj)
-     :length ,length
-     :null-terminated-p ,null-terminated-p))
-  #+mcl
+  (let ((stored-obj (gensym)))
+    `(let ((,stored-obj ,obj))
+       (if (null-pointer-p ,stored-obj)
+	    nil
+	    (sbcl-naturalize-cstring (sb-alien:alien-sap ,stored-obj)
+				     :length ,length
+				     :null-terminated-p ,null-terminated-p))))
+  #+(or openmcl digitool)
   (declare (ignore null-terminated-p))
-  #+mcl
-  `(if (ccl:%null-ptr-p ,obj)
-     nil
-     (ccl:%get-cstring ,obj 0 ,@(if length (list length) nil)))
+  #+(or openmcl digitool)
+  (let ((stored-obj (gensym)))
+    `(let ((,stored-obj ,obj))
+       (if (ccl:%null-ptr-p ,stored-obj)
+	   nil
+	   #+digitool (ccl:%get-cstring
+				      ,stored-obj 0
+				      ,@(if length (list length) nil))
+	   #+openmcl ,@(if length
+			   `((ccl:%str-from-ptr ,stored-obj ,length))
+			   `((ccl:%get-cstring ,stored-obj))))))
   )
 
 
 (defmacro allocate-foreign-string (size &key (unsigned t))
-  #+(or cmu scl)
+  #+ignore
   (let ((array-def (gensym)))
     `(let ((,array-def (list 'alien:array 'c-call:char ,size)))
-       (eval `(alien:cast (alien:make-alien ,,array-def) 
-			  ,(if ,unsigned 
+       (eval `(alien:cast (alien:make-alien ,,array-def)
+			  ,(if ,unsigned
 			       '(* (alien:unsigned 8))
 			     '(* (alien:signed 8)))))))
+
+  #+(or cmu scl)
+  `(alien:make-alien ,(if unsigned
+			     '(alien:unsigned 8)
+			     '(alien:signed 8))
+    ,size)
+
   #+sbcl
-  (let ((array-def (gensym)))
-    `(let ((,array-def (list 'sb-alien:array 'char ,size)))
-       (eval `(sb-alien:cast (sb-alien:make-alien ,,array-def) 
-			  ,(if ,unsigned 
-			       '(* (sb-alien:unsigned 8))
-			     '(* (sb-alien:signed 8)))))))
+  `(sb-alien:make-alien ,(if unsigned
+			     '(sb-alien:unsigned 8)
+			     '(sb-alien:signed 8))
+    ,size)
+
   #+lispworks
-  `(fli:allocate-foreign-object :type 
-				,(if unsigned 
-				     ''(:unsigned :char) 
+  `(fli:allocate-foreign-object :type
+				,(if unsigned
+				     ''(:unsigned :char)
 				   :char)
 				:nelems ,size)
   #+allegro
   (declare (ignore unsigned))
   #+allegro
   `(ff:allocate-fobject :char :c ,size)
-  #+mcl
+  #+(or openmcl digitool)
   (declare (ignore unsigned))
-  #+mcl
+  #+(or openmcl digitool)
   `(new-ptr ,size)
   )
 
+(defun foreign-string-length (foreign-string)
+  #+allegro `(ff:foreign-strlen ,foreign-string)
+  #-allegro
+  `(loop with size = 0
+    until (char= (deref-array ,foreign-string '(:array :unsigned-char) size) #\Null)
+    do (incf size)
+    finally return size))
+
+
 (defmacro with-foreign-string ((foreign-string lisp-string) &body body)
   (let ((result (gensym)))
     `(let* ((,foreign-string (convert-to-foreign-string ,lisp-string))
@@ -231,6 +284,11 @@
       (free-foreign-object ,foreign-string)
       ,result)))
 
+(defmacro with-foreign-strings (bindings &body body)
+  `(with-foreign-string ,(car bindings)
+    ,@(if (cdr bindings)
+          `((with-foreign-strings ,(cdr bindings) , at body))
+          body)))
 
 ;; Modified from CMUCL's source to handle non-null terminated strings
 #+cmu
@@ -280,53 +338,75 @@
 	(setf (char result i) (code-char (system:sap-ref-8 sap i))))
       result)))
 
-#+sbcl
+#+(and sbcl (not sb-unicode))
 (defun sbcl-naturalize-cstring (sap &key length (null-terminated-p t))
-  (declare (type sb-sys:system-area-pointer sap))
+  (declare (type sb-sys:system-area-pointer sap)
+	   (type (or null fixnum) length))
   (locally
-      (declare (optimize (speed 3) (safety 0)))
-    (let ((null-terminated-length
-	   (when null-terminated-p
-	     (loop
-		 for offset of-type fixnum upfrom 0
-		 until (zerop (sb-sys:sap-ref-8 sap offset))
-		 finally (return offset)))))
-      (if length
-	  (if (and null-terminated-length
-		   (> (the fixnum length) (the fixnum null-terminated-length)))
-	      (setq length null-terminated-length))
-	(setq length null-terminated-length)))
-    (let ((result (make-string length)))
-      (sb-kernel:copy-from-system-area sap 0
-				    result (* sb-vm:vector-data-offset
-					      sb-vm:n-word-bits)
-				    (* length sb-vm:n-byte-bits))
-      result)))
+   (declare (optimize (speed 3) (safety 0)))
+   (let ((null-terminated-length
+	  (when null-terminated-p
+	    (loop
+	     for offset of-type fixnum upfrom 0
+	     until (zerop (sb-sys:sap-ref-8 sap offset))
+	     finally (return offset)))))
+     (if length
+	 (if (and null-terminated-length
+		  (> (the fixnum length) (the fixnum null-terminated-length)))
+	     (setq length null-terminated-length))
+       (setq length null-terminated-length)))
+   (let ((result (make-string length)))
+       (funcall *system-copy-fn* sap 0 result +system-copy-offset+
+		(* length +system-copy-multiplier+))
+       result)))
 
+#+(and sbcl sb-unicode)
+(defun sbcl-naturalize-cstring (sap &key length (null-terminated-p t))
+  (declare (type sb-sys:system-area-pointer sap)
+	   (type (or null fixnum) length))
+  (locally
+   (declare (optimize (speed 3) (safety 0)))
+   (cond
+    (null-terminated-p
+     (let ((casted (sb-alien:cast (sb-alien:sap-alien sap (* char))
+				  #+sb-unicode sb-alien:utf8-string
+				  #-sb-unicode sb-alien:c-string)))
+       (if length
+	   (copy-seq (subseq casted 0 length))
+	 (copy-seq casted))))
+    (t
+     (let ((result (make-string length)))
+       ;; this will not work in sb-unicode
+       (funcall *system-copy-fn* sap 0 result +system-copy-offset+
+		(* length +system-copy-multiplier+))
+       result)))))
 
-(def-function "strlen"
-    ((str (* :unsigned-char)))
-  :returning :unsigned-int)
 
+(eval-when (:compile-toplevel :load-toplevel :execute)
+   (def-function "strlen"
+     ((str (* :unsigned-char)))
+     :returning :unsigned-int))
+
 (def-type char-ptr-def (* :unsigned-char))
 
-#+(or lispworks (and allegro (not ics)))
+#+(or (and allegro (not ics)) (and lispworks (not lispworks5)))
 (defun fast-native-to-string (s len)
   (declare (optimize (speed 3) (space 0) (safety 0) (compilation-speed 0))
 	   (type char-ptr-def s))
   (let* ((len (or len (strlen s)))
          (str (make-string len)))
     (declare (fixnum len)
-	     (type (simple-array (signed-byte 8) (*)) str))
+	     (type (simple-array #+lispworks base-char
+                                 #-lispworks (signed-byte 8) (*)) str))
     (dotimes (i len str)
-      (setf (aref str i) 
+      (setf (aref str i)
 	(uffi:deref-array s '(:array :char) i)))))
 
-#+(and allegro ics)
+#+(or (and allegro ics) lispworks5)
 (defun fast-native-to-string (s len)
   (declare (optimize (speed 3) (space 0) (safety 0) (compilation-speed 0))
 	   (type char-ptr-def s))
   (let* ((len (or len (strlen s)))
          (str (make-string len)))
       (dotimes (i len str)
-        (setf (aref str i) (uffi:deref-array s '(:array :char) i)))))
+        (setf (schar str i) (code-char (uffi:deref-array s '(:array :unsigned-byte) i))))))

Modified: branches/xml-class-rework/thirdparty/uffi/tests/Makefile
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/tests/Makefile	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/tests/Makefile	2006-10-22 16:42:37 UTC (rev 2025)
@@ -5,13 +5,9 @@
 #  Programer:    Kevin M. Rosenberg
 #  Date Started: Mar 2002
 #
-#  CVS Id:   $Id: Makefile,v 1.1 2004/06/23 08:27:10 hans Exp $
+#  CVS Id:   $Id$
 #
-# This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
-#
-# UFFI users are granted the rights to distribute and use this software
-# as governed by the terms of the Lisp Lesser GNU Public License
-# (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+# This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 
 SUBDIRS=
 

Modified: branches/xml-class-rework/thirdparty/uffi/tests/Makefile.msvc
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/tests/Makefile.msvc	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/tests/Makefile.msvc	2006-10-22 16:42:37 UTC (rev 2025)
@@ -5,13 +5,10 @@
 #  Programer:    Kevin M. Rosenberg
 #  Date Started: Mar 2002
 #
-#  CVS Id:   $Id: Makefile.msvc,v 1.1 2004/06/23 08:27:10 hans Exp $
+#  CVS Id:   $Id$
 #
-# This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+# This file, part of CLSQL, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 #
-# CLSQL users are granted the rights to distribute and use this software
-# as governed by the terms of the Lisp Lesser GNU Public License
-# (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 
 BASE=c-test-fns
 

Modified: branches/xml-class-rework/thirdparty/uffi/tests/arrays.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/tests/arrays.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/tests/arrays.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,9 +7,9 @@
 ;;;; Author:        Kevin M. Rosenberg
 ;;;; Date Started:  Mar 2002
 ;;;;
-;;;; $Id: arrays.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
 ;;;; *************************************************************************
 
@@ -18,9 +18,9 @@
 (uffi:def-constant +column-length+ 10)
 (uffi:def-constant +row-length+ 10)
 
-(uffi:def-foreign-type long-ptr '(* :long))
+(uffi:def-foreign-type long-ptr (* :long))
 
-(deftest array.1
+(deftest :array.1
     (let ((a (uffi:allocate-foreign-object :long +column-length+))
 	  (results nil))
       (dotimes (i +column-length+)
@@ -32,7 +32,7 @@
   (0 1 4 9 16 25 36 49 64 81))
 
 
-(deftest array.2
+(deftest :array.2
     (let ((a (uffi:allocate-foreign-object 'long-ptr +row-length+))
 	  (results nil))
       (dotimes (r +row-length+)

Modified: branches/xml-class-rework/thirdparty/uffi/tests/atoifl.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/tests/atoifl.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/tests/atoifl.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,9 +7,9 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Mar 2002
 ;;;;
-;;;; $Id: atoifl.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
 ;;;; *************************************************************************
 
@@ -37,6 +37,6 @@
   (uffi:with-cstring (str-cstring str)
     (c-atof str-cstring)))
   
-(deftest atoi.1 (atoi "123") 123)
-(deftest atoi.2 (atoi "") 0)
-(deftest atof.3 (atof "2.23") 2.23d0)
+(deftest :atoi.1 (atoi "123") 123)
+(deftest :atoi.2 (atoi "") 0)
+(deftest :atof.3 (atof "2.23") 2.23d0)

Modified: branches/xml-class-rework/thirdparty/uffi/tests/casts.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/tests/casts.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/tests/casts.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -1,27 +1,31 @@
 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
+;;;; FILE IDENTIFICAION
 ;;;;
 ;;;; Name:          casts.lisp
 ;;;; Purpose:       Tests of with-cast-pointer
 ;;;; Programmer:    Kevin M. Rosenberg / Edi Weitz
 ;;;; Date Started:  Aug 2003
 ;;;;
-;;;; $Id: casts.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2003-2005 by Kevin M. Rosenberg
+;;;;
 ;;;; *************************************************************************
 
 (in-package #:uffi-tests)
 
 (uffi:def-function ("cast_test_int" cast-test-int)
     ()
+  :module "uffi_tests"
   :returning :pointer-void)
 
 (uffi:def-function ("cast_test_float" cast-test-float)
     ()
+  :module "uffi_tests"
   :returning :pointer-void)
 
-(deftest cast.1
+(deftest :cast.1
   (progn
     (uffi:with-cast-pointer (temp (cast-test-int) :int)
       (assert (= (uffi:deref-pointer temp :int) 23)))
@@ -33,7 +37,7 @@
     t)
   t)
 
-(deftest cast.2
+(deftest :cast.2
     (progn
       (uffi:with-cast-pointer (temp (cast-test-float) :double)
 	(assert (= (uffi:deref-pointer temp :double) 3.21d0)))

Modified: branches/xml-class-rework/thirdparty/uffi/tests/compress.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/tests/compress.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/tests/compress.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,9 +7,9 @@
 ;;;; Author:        Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: compress.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
 ;;;; *************************************************************************
 
@@ -36,10 +36,8 @@
 	    (newdestlen (uffi:deref-pointer destlen :long)))
 	(unwind-protect
 	    (if (zerop result)
-		(values (uffi:convert-from-foreign-string 
-			 dest
-			 :length newdestlen
-			 :null-terminated-p nil)
+		(values (uffi:convert-from-foreign-usb8 
+			 dest newdestlen)
 			newdestlen)
 	      (error "zlib error, code ~D" result))
 	  (progn
@@ -74,12 +72,12 @@
 	    (uffi:free-foreign-object destlen)
 	    (uffi:free-foreign-object dest)))))))
 
-(deftest compress.1 (map 'list #'char-code (compress ""))
-  (120 156 3 0 0 0 0 1))
-(deftest compress.2 (map 'list #'char-code  (compress "test"))
-  (120 156 43 73 45 46 1 0 4 93 1 193))
-(deftest compress.3 (map 'list #'char-code (compress "test2"))
-  (120 156 43 73 45 46 49 2 0 6 80 1 243))
+(deftest :compress.1 (compress "")
+  #(120 156 3 0 0 0 0 1) 8)
+(deftest :compress.2  (compress "test")
+  #(120 156 43 73 45 46 1 0 4 93 1 193) 12)
+(deftest :compress.3 (compress "test2")
+  #(120 156 43 73 45 46 49 2 0 6 80 1 243) 13)
 
 (defun compress-uncompress (str)
   (multiple-value-bind (compressed len) (compress str)
@@ -89,6 +87,6 @@
       uncompressed)))
 
 
-(deftest uncompress.1 "" "")
-(deftest uncompress.2 "test" "test")
-(deftest uncompress.3 "test2" "test2")
+(deftest :uncompress.1 "" "")
+(deftest :uncompress.2 "test" "test")
+(deftest :uncompress.3 "test2" "test2")

Modified: branches/xml-class-rework/thirdparty/uffi/tests/foreign-loader.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/tests/foreign-loader.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/tests/foreign-loader.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,9 +7,9 @@
 ;;;; Author:        Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: foreign-loader.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
 ;;;; *************************************************************************
 
@@ -18,6 +18,8 @@
 
 (in-package uffi-tests)
 
+#+clisp (uffi:load-foreign-library "/usr/lib/libz.so" :module "z")
+#-clisp
 (unless (uffi:load-foreign-library
 	 (uffi:find-foreign-library
 	  #-(or macosx darwin)
@@ -25,16 +27,20 @@
 	  #+(or macosx darwin)
 	  "z"
 	  (list (pathname-directory *load-pathname*)
-		"/usr/local/lib/" "/usr/lib/" "/zlib/"))
-	 :module "zlib" 
+		"/usr/local/lib/" #+(or 64bit x86-64) "/usr/lib64/"
+		"/usr/lib/" "/zlib/"))
+	 :module "zlib"
 	 :supporting-libraries '("c"))
   (warn "Unable to load zlib"))
-  
-(unless (uffi:load-foreign-library 
+
+#+clisp (uffi:load-foreign-library "/home/kevin/debian/src/uffi/tests/uffi-c-test.so" :module "uffi_tests")
+#-clisp
+(unless (uffi:load-foreign-library
 	 (uffi:find-foreign-library
-	  "uffi-c-test" 
+	  '(#+(or 64bit x86-64) "uffi-c-test64" "uffi-c-test")
 	  (list (pathname-directory *load-truename*)
-		"/usr/lib/uffi/"))
+		"/usr/lib/uffi/"
+		"/home/kevin/debian/src/uffi/tests/"))
 	 :supporting-libraries '("c")
 	 :module "uffi_tests")
   (warn "Unable to load uffi-c-test library"))

Modified: branches/xml-class-rework/thirdparty/uffi/tests/foreign-var.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/tests/foreign-var.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/tests/foreign-var.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,8 +7,10 @@
 ;;;; Authors:       Kevin M. Rosenberg and Edi Weitz
 ;;;; Date Started:  Aug 2003
 ;;;;
-;;;; $Id: foreign-var.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2003-2005 by Kevin M. Rosenberg
+;;;
 ;;;; *************************************************************************
 
 (in-package #:uffi-tests)
@@ -22,16 +24,15 @@
 (def-foreign-var "float_neg_4_5" :float "uffi_tests")
 (def-foreign-var "double_3_1" :double "uffi_tests")
 
-(deftest fvar.1 uchar-13 13)
-(deftest fvar.2 schar-neg-120 -120)
-(deftest fvar.3 uword-257 257)
-(deftest fvar.4 sword-neg-321 -321)
-(deftest fvar.5 uint-1234567 1234567)
-(deftest fvar.6 sint-neg-123456 -123456)
-(deftest fvar.7 float-neg-4-5 -4.5f0)
-(deftest fvar.8 double-3-1 3.1d0)
+(deftest :fvar.1 uchar-13 13)
+(deftest :fvar.2 schar-neg-120 -120)
+(deftest :fvar.3 uword-257 257)
+(deftest :fvar.4 sword-neg-321 -321)
+(deftest :fvar.5 uint-1234567 1234567)
+(deftest :fvar.6 sint-neg-123456 -123456)
+(deftest :fvar.7 float-neg-4-5 -4.5f0)
+(deftest :fvar.8 double-3-1 3.1d0)
 
-
 (uffi:def-foreign-var ("fvar_addend" *fvar-addend*) :int "uffi_tests")
 
 (uffi:def-struct fvar-struct
@@ -51,14 +52,14 @@
     :returning :double
     :module "uffi_tests")
  
-(deftest fvarst.1 *fvar-addend* 3)
-(deftest fvarst.2 (uffi:get-slot-value *fvar-struct* 'fvar-struct 'i) 42)
-(deftest fvarst.3 (= (+ *fvar-addend*
+(deftest :fvarst.1 *fvar-addend* 3)
+(deftest :fvarst.2 (uffi:get-slot-value *fvar-struct* 'fvar-struct 'i) 42)
+(deftest :fvarst.3 (= (+ *fvar-addend*
 			(uffi:get-slot-value *fvar-struct* 'fvar-struct 'i))
 		     (fvar-struct-int))
   t)
-(deftest fvarst.4 (uffi:get-slot-value *fvar-struct* 'fvar-struct 'd) 3.2d0)
-(deftest fvarst.5 (= (uffi:get-slot-value *fvar-struct* 'fvar-struct 'd)
+(deftest :fvarst.4 (uffi:get-slot-value *fvar-struct* 'fvar-struct 'd) 3.2d0)
+(deftest :fvarst.5 (= (uffi:get-slot-value *fvar-struct* 'fvar-struct 'd)
 		     (fvar-struct-double))
   t)
 

Modified: branches/xml-class-rework/thirdparty/uffi/tests/getenv.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/tests/getenv.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/tests/getenv.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,9 +7,9 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: getenv.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
 ;;;; *************************************************************************
 
@@ -51,11 +51,11 @@
   (uffi:with-cstrings ((key-native key))
     (c-unsetenv key-native)))
 
-(deftest getenv.1 (progn
+(deftest :getenv.1 (progn
 		    (my-unsetenv "__UFFI_FOO1__")
 		    (my-getenv "__UFFI_FOO1__"))
   nil)
-(deftest getenv.2 (progn
+(deftest :getenv.2 (progn
 		    (my-setenv "__UFFI_FOO1__" "UFFI-TEST")
 		    (my-getenv "__UFFI_FOO1__"))
   "UFFI-TEST")

Modified: branches/xml-class-rework/thirdparty/uffi/tests/gethostname.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/tests/gethostname.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/tests/gethostname.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,9 +7,9 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: gethostname.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
 ;;;; *************************************************************************
 
@@ -42,11 +42,11 @@
 	  (uffi:convert-from-foreign-string name)
 	  (error "gethostname() failed.")))))
 
-(deftest gethostname.1 (stringp (gethostname)) t)
-(deftest gethostname.2 (stringp (gethostname2)) t)
-(deftest gethostname.3 (plusp (length (gethostname))) t)
-(deftest gethostname.4 (plusp (length (gethostname2))) t)
-(deftest gethostname.5 (gethostname) #.(gethostname2))
+(deftest :gethostname.1 (stringp (gethostname)) t)
+(deftest :gethostname.2 (stringp (gethostname2)) t)
+(deftest :gethostname.3 (plusp (length (gethostname))) t)
+(deftest :gethostname.4 (plusp (length (gethostname2))) t)
+(deftest :gethostname.5 (string= (gethostname) (gethostname2)) t)
 
 
 

Modified: branches/xml-class-rework/thirdparty/uffi/tests/make.sh
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/tests/make.sh	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/tests/make.sh	2006-10-22 16:42:37 UTC (rev 2025)
@@ -2,17 +2,32 @@
 
 case "`uname`" in
     Linux) os_linux=1 ;;
+    FreeBSD) os_freebsd=1 ;;
+    GNU/kFreeBSD) os_gnukfreebsd=1;;
     Darwin) os_darwin=1 ;;
     SunOS) os_sunos=1 ;;
     AIX) os_aix=1 ;;
+    GNU) os_gnu=1 ;;
     *) echo "Unable to identify uname " `uname`
-       exit 1 ;;	
+       exit 1 ;;
 esac
-    
+
 if [ "$os_linux" ]; then
     gcc -fPIC -DPIC -c $SOURCE -o $OBJECT
     gcc -shared $OBJECT -o $SHARED_LIB
 
+elif [ "$os_gnu" ]; then
+    gcc -fPIC -DPIC -c $SOURCE -o $OBJECT
+    gcc -shared $OBJECT -o $SHARED_LIB
+
+elif [ "$os_freebsd" ]; then
+    gcc -fPIC -DPIC -c $SOURCE -o $OBJECT
+    gcc -shared $OBJECT -o $SHARED_LIB
+
+elif [ "$os_gnukfreebsd" ]; then
+    gcc -fPIC -DPIC -c $SOURCE -o $OBJECT
+    gcc -shared $OBJECT -o $SHARED_LIB
+
 elif [ "$os_darwin" ]; then
     cc -dynamic -c $SOURCE -o $OBJECT
     ld -bundle /usr/lib/bundle1.o -flat_namespace -undefined suppress -o $BASE.dylib $OBJECT

Added: branches/xml-class-rework/thirdparty/uffi/tests/objects.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/tests/objects.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/tests/objects.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -0,0 +1,70 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          pointers.lisp
+;;;; Purpose:       Test file for UFFI pointers
+;;;; Programmer:    Kevin M. Rosenberg
+;;;; Date Started:  Aug 2003
+;;;;
+;;;; $Id: objects.lisp 10608 2005-07-01 00:39:48Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2003-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package #:uffi-tests)
+
+(deftest :chptr.1
+    (let ((native-string "test string"))
+      (uffi:with-foreign-string (fs native-string)
+	(ensure-char-character
+	 (deref-pointer fs :char))))
+  #\t)
+
+(deftest :chptr.2
+    (let ((native-string "test string"))
+      (uffi:with-foreign-string (fs native-string)
+	(ensure-char-character
+	 (deref-pointer fs :unsigned-char))))
+  #\t)
+
+(deftest :chptr.3
+    (let ((native-string "test string"))
+      (uffi:with-foreign-string (fs native-string)
+	(ensure-char-integer
+	 (deref-pointer fs :unsigned-char))))
+  116)
+
+(deftest :chptr.4
+    (let ((native-string "test string"))
+      (uffi:with-foreign-string (fs native-string)
+	(integerp
+	 (ensure-char-integer
+	  (deref-pointer fs :unsigned-char)))))
+  t)
+	
+(deftest :chptr.5
+    (let ((fs (uffi:allocate-foreign-object :unsigned-char 128)))
+      (setf (uffi:deref-array fs '(:array :unsigned-char) 0)
+	    (uffi:ensure-char-storable #\a))
+      (setf (uffi:deref-array fs '(:array :unsigned-char) 1)
+	    (uffi:ensure-char-storable (code-char 0)))
+      (uffi:convert-from-foreign-string fs))
+  "a")
+
+;; This produces an array which needs fli:foreign-aref to access
+;; rather than fli:dereference
+
+#-lispworks
+(deftest :chptr.6
+    (uffi:with-foreign-object (fs '(:array :unsigned-char 128))
+      (setf (uffi:deref-array fs '(:array :unsigned-char) 0)
+	    (uffi:ensure-char-storable #\a))
+      (setf (uffi:deref-array fs '(:array :unsigned-char) 1)
+	    (uffi:ensure-char-storable (code-char 0)))
+      (uffi:convert-from-foreign-string fs))
+  "a")
+
+      
+				  

Modified: branches/xml-class-rework/thirdparty/uffi/tests/package.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/tests/package.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/tests/package.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,7 +7,9 @@
 ;;;; Author:        Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2003
 ;;;;
-;;;; $Id: package.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; This file, part of UFFI, is Copyright (c) 2003-2005 by Kevin M. Rosenberg
+;;;;
+;;;; $Id$
 ;;;; *************************************************************************
 
 (defpackage #:uffi-tests

Modified: branches/xml-class-rework/thirdparty/uffi/tests/strtol.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/tests/strtol.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/tests/strtol.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,9 +7,9 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: strtol.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
 ;;;; *************************************************************************
 
@@ -54,10 +54,10 @@
 	(uffi:free-foreign-object str-native)
 	(uffi:free-foreign-object endptr)))))
 
-(deftest strtol.1 (strtol "123") 123 t)
-(deftest strtol.2 (strtol "0") 0 t)
-(deftest strtol.3 (strtol "55a") 55 2)
-(deftest strtol.4 (strtol "a") nil nil)
+(deftest :strtol.1 (strtol "123") 123 t)
+(deftest :strtol.2 (strtol "0") 0 t)
+(deftest :strtol.3 (strtol "55a") 55 2)
+(deftest :strtol.4 (strtol "a") nil nil)
 
 
 			   

Modified: branches/xml-class-rework/thirdparty/uffi/tests/structs.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/tests/structs.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/tests/structs.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,9 +7,9 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: structs.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
 ;;;; *************************************************************************
 
@@ -24,8 +24,13 @@
 (uffi:def-foreign-type foo-ptr (* foo))
 
 ;; tests that compilation worked
-(deftest structs.1 
+(deftest :structs.1 
   (with-foreign-object (p 'foo)
     t)
   t)
 
+(deftest :structs.2
+    (progn
+      (uffi:def-foreign-type foo-struct (:struct foo))
+      t)
+  t)

Modified: branches/xml-class-rework/thirdparty/uffi/tests/time.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/tests/time.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/tests/time.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,9 +7,9 @@
 ;;;; Author:        Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: time.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
 ;;;; *************************************************************************
 
@@ -26,36 +26,42 @@
   (year :int)
   (wday :int)
   (yday :int)
-  (isdst :int))
+  (isdst :int)
+  ;; gmoffset present on SusE SLES9
+  (gmoffset :long))
 
 (uffi:def-function ("time" c-time) 
     ((time (* time-t)))
   :returning time-t)
 
-(uffi:def-function ("gmtime" c-gmtime)
+(uffi:def-function "gmtime"
     ((time (* time-t)))
-  :returning (* tm))
+  :returning (:struct-pointer tm))
 
+(uffi:def-function "asctime"
+    ((time (:struct-pointer tm)))
+  :returning :cstring)
+
 (uffi:def-type time-t :unsigned-long)
-(uffi:def-type tm-pointer (* tm))
+(uffi:def-type tm-pointer (:struct-pointer tm))
 
-(deftest time.1
+(deftest :time.1
    (uffi:with-foreign-object (time 'time-t)
      (setf (uffi:deref-pointer time :unsigned-long) 7381)
      (uffi:deref-pointer time :unsigned-long))
   7381)
 
-(deftest time.2
-   (uffi:with-foreign-object (time 'time-t)
-     (setf (uffi:deref-pointer time :unsigned-long) 7381)
-     (let ((tm-ptr (the tm-pointer (c-gmtime time))))
-       (values (1+ (uffi:get-slot-value tm-ptr 'tm 'mon))
-	       (uffi:get-slot-value tm-ptr 'tm 'mday)
-	       (+ 1900 (uffi:get-slot-value tm-ptr 'tm 'year))
-	       (uffi:get-slot-value tm-ptr 'tm 'hour)
-	       (uffi:get-slot-value tm-ptr 'tm 'min)
-	       (uffi:get-slot-value tm-ptr 'tm 'sec)
-	       )))
+(deftest :time.2
+  (uffi:with-foreign-object (time 'time-t)
+    (setf (uffi:deref-pointer time :unsigned-long) 7381)
+    (let ((tm-ptr (the tm-pointer (gmtime time))))
+      (values (1+ (uffi:get-slot-value tm-ptr 'tm 'mon))
+	      (uffi:get-slot-value tm-ptr 'tm 'mday)
+	      (+ 1900 (uffi:get-slot-value tm-ptr 'tm 'year))
+	      (uffi:get-slot-value tm-ptr 'tm 'hour)
+	      (uffi:get-slot-value tm-ptr 'tm 'min)
+	      (uffi:get-slot-value tm-ptr 'tm 'sec)
+	      )))
   1 1 1970 2 3 1)
 
 
@@ -80,7 +86,7 @@
 	  (uffi:get-slot-value tv 'timeval 'usecs))
        res))))
 
-(deftest timeofday.1
+(deftest :timeofday.1
     (multiple-value-bind (t1 res1) (get-utime)
       (multiple-value-bind (t2 res2) (get-utime)
 	(and (or (= t2 t1) (> t2 t1))
@@ -90,3 +96,15 @@
 	     (zerop res2))))
   t)
 	     
+(defun posix-time-to-asctime (secs)
+  "Converts number of seconds elapsed since 00:00:00 on January 1, 1970, Coordinated Universal Time (UTC)"
+  (string-right-trim
+   '(#\newline #\return)
+   (uffi:convert-from-cstring
+    (uffi:with-foreign-object (time 'time-t)
+      (setf (uffi:deref-pointer time :unsigned-long) secs)
+      (asctime (gmtime time))))))
+
+(deftest :time.3
+    (posix-time-to-asctime 0)
+  "Thu Jan  1 00:00:00 1970")

Modified: branches/xml-class-rework/thirdparty/uffi/tests/uffi-c-test-lib.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/tests/uffi-c-test-lib.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/tests/uffi-c-test-lib.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,9 +7,9 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Mar 2002
 ;;;;
-;;;; $Id: uffi-c-test-lib.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
 ;;;; *************************************************************************
 
@@ -19,7 +19,7 @@
 (uffi:def-function ("cs_to_upper" cs-to-upper)
   ((input (* :unsigned-char)))
   :returning :void
-  )
+  :module "uffi_tests")
 
 (defun string-to-upper (str)
   (uffi:with-foreign-string (str-foreign str)
@@ -29,17 +29,34 @@
 (uffi:def-function ("cs_count_upper" cs-count-upper)
   ((input :cstring))
   :returning :int
-  )
+  :module "uffi_tests")
 
 (defun string-count-upper (str)
   (uffi:with-cstring (str-cstring str)
-    (cs-count-upper str-cstring)))
+    (cs-count-upper str-cstring))) 
 
 (uffi:def-function ("half_double_vector" half-double-vector)
     ((size :int)
      (vec (* :double)))
-  :returning :void)
+  :returning :void
+  :module "uffi_tests")
 
+(uffi:def-function ("return_long_negative_one" return-long-negative-one)
+    ()
+  :returning :long
+  :module "uffi_tests")
+
+(uffi:def-function ("return_int_negative_one" return-int-negative-one)
+    ()
+  :returning :int
+  :module "uffi_tests")
+
+(uffi:def-function ("return_short_negative_one" return-short-negative-one)
+    ()
+  :returning :short
+  :module "uffi_tests")
+
+
 (uffi:def-constant +double-vec-length+ 10)
 (defun test-half-double-vector ()
   (let ((vec (uffi:allocate-foreign-object :double +double-vec-length+))
@@ -69,10 +86,13 @@
      (half-double-vector +double-vec-length+ (system:vector-sap vec)))
     vec))
     
-(deftest c-test.1 (string-to-upper "this is a test") "THIS IS A TEST")
-(deftest c-test.2 (string-to-upper nil) nil)
-(deftest c-test.3 (string-count-upper "This is a Test") 2)
-(deftest c-test.4 (string-count-upper nil) -1)
-(deftest c-test.5 (test-half-double-vector)
+(deftest :c-test.1 (string-to-upper "this is a test") "THIS IS A TEST")
+(deftest :c-test.2 (string-to-upper nil) nil)
+(deftest :c-test.3 (string-count-upper "This is a Test") 2)
+(deftest :c-test.4 (string-count-upper nil) -1)
+(deftest :c-test.5 (test-half-double-vector)
   (0.0d0 0.5d0 1.0d0 1.5d0 2.0d0 2.5d0 3.0d0 3.5d0 4.0d0 4.5d0))
+(deftest :c-test.6 (return-long-negative-one) -1)
+(deftest :c-test.7 (return-int-negative-one) -1)
+(deftest :c-test.8 (return-short-negative-one) -1)
 

Modified: branches/xml-class-rework/thirdparty/uffi/tests/uffi-c-test.c
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/tests/uffi-c-test.c	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/tests/uffi-c-test.c	2006-10-22 16:42:37 UTC (rev 2025)
@@ -6,14 +6,10 @@
  *  Programer:    Kevin M. Rosenberg
  *  Date Started: Mar 2002
  *
- *  CVS Id:   $Id: uffi-c-test.c,v 1.1 2004/06/23 08:27:10 hans Exp $
+ *  CVS Id:   $Id$
  *
- * This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+ * This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
  *
- * UFFI users are granted the rights to distribute and use this software
- * as governed by the terms of the Lisp Lesser GNU Public License
- * (http://opensource.franz.com/preamble.html), also known as the LLGPL.
-
  * These variables are correct for GCC
  * you'll need to modify these for other compilers
  ***************************************************************************/
@@ -119,6 +115,27 @@
   return y;
 }
 
+DLLEXPORT
+long
+return_long_negative_one ()
+{
+  return -1;
+}
+
+DLLEXPORT
+int
+return_int_negative_one ()
+{
+  return -1;
+}
+
+DLLEXPORT
+short
+return_short_negative_one ()
+{
+  return -1;
+}
+
 DLLEXPORT int fvar_addend = 3;
 
 typedef struct {

Modified: branches/xml-class-rework/thirdparty/uffi/tests/union.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/tests/union.lisp	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/tests/union.lisp	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,9 +7,9 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Mar 2002
 ;;;;
-;;;; $Id: union.lisp,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
 ;;;; *************************************************************************
 
@@ -35,12 +35,37 @@
 	 (* 256 (char-code #\C))
 	 (* 1 128)))
 
-(deftest union.1 (uffi:ensure-char-character 
-		  (uffi:get-slot-value *u* 'tunion1 'char)) #\A)
+(deftest :union.1 
+    (uffi:ensure-char-character 
+     (uffi:get-slot-value *u* 'tunion1 'char))
+  #\A)
 
-#-(or sparc sparc-v9 mcl)
-(deftest union.2 (plusp (uffi:get-slot-value *u* 'tunion1 'uint)) t)
+(deftest :union.2 
+    (uffi:ensure-char-integer 
+     (uffi:get-slot-value *u* 'tunion1 'char))
+  65)
 
+#-(or sparc sparc-v9 openmcl digitool)
+(deftest :union.3 (plusp (uffi:get-slot-value *u* 'tunion1 'uint)) t)
 
-;;    (uffi:free-foreign-object u))
 
+(uffi:def-union foo-u
+    (bar :pointer-self))
+
+(uffi:def-foreign-type foo-u-ptr (* foo-u))
+
+;; tests that compilation worked
+(deftest :unions.4 
+  (with-foreign-object (p 'foo-u)
+    t)
+  t)
+
+(deftest :unions.5
+    (progn
+      (uffi:def-foreign-type foo-union (:union foo-u))
+      t)
+  t)
+
+
+
+

Modified: branches/xml-class-rework/thirdparty/uffi/uffi-tests.asd
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/uffi-tests.asd	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/uffi-tests.asd	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,13 +7,15 @@
 ;;;; Author:        Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2003
 ;;;;
-;;;; $Id: uffi-tests.asd,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;; *************************************************************************
 
 (defpackage #:uffi-tests-system
   (:use #:asdf #:cl))
 (in-package #:uffi-tests-system)
 
+(operate 'load-op 'uffi)
+
 (defvar *library-file-dir* (append (pathname-directory *load-truename*)
 				   (list "tests")))
 
@@ -21,28 +23,47 @@
   ())
 
 (defmethod output-files ((o compile-op) (c uffi-test-source-file))
-  (let ((found (some #'(lambda (dir)
-			    (probe-file (make-pathname :directory dir
-						       :name (component-name c)
-						       :type "so")))
-			'((:absolute "usr" "lib" "uffi")))))
+  (let* ((library-file-type
+	  (funcall (intern (symbol-name'#:default-foreign-library-type)
+			   (symbol-name '#:uffi))))
+	 (found
+	  (some #'(lambda (dir)
+		    (probe-file (make-pathname
+				 :directory dir
+				 :name (component-name c)
+				 :type library-file-type)))
+		'((:absolute "usr" "lib" "uffi")))))
     (list (if found
 	      found
 	      (make-pathname :name (component-name c)
-			     :type "so"
+			     :type library-file-type
 			     :directory *library-file-dir*)))))
 
 (defmethod perform ((o load-op) (c uffi-test-source-file))
-  nil) ;; lisp loader file will load library
+  nil) ;;; library will be loaded by a loader file
 
+(defmethod operation-done-p ((o load-op) (c uffi-test-source-file))
+  (and (symbol-function (intern (symbol-name '#:cs-count-upper)
+				(find-package '#:uffi-tests)))
+       t))
+
 (defmethod perform ((o compile-op) (c uffi-test-source-file))
-  (unless (zerop (run-shell-command
-		  "cd ~A; make"
-		  (namestring (make-pathname :name nil
-					     :type nil
-					     :directory *library-file-dir*))))
-    (error 'operation-error :component c :operation o)))
+  (unless (operation-done-p o c)
+    #-(or win32 mswindows)
+    (unless (zerop (run-shell-command
+		    #-freebsd "cd ~A; make"
+		    #+freebsd "cd ~A; gmake"
+		    (namestring (make-pathname :name nil
+					       :type nil
+					       :directory *library-file-dir*))))
+      (error 'operation-error :component c :operation o))))
 
+(defmethod operation-done-p ((o compile-op) (c uffi-test-source-file))
+  (or (and (probe-file #p"/usr/lib/uffi/uffi-c-test.so") t)
+      (let ((lib (make-pathname :defaults (component-pathname c)
+				:type (uffi:default-foreign-library-type))))
+	(and (probe-file lib)
+	     (> (file-write-date lib) (file-write-date (component-pathname c)))))))
 
 (defsystem uffi-tests
     :depends-on (:uffi)
@@ -50,8 +71,8 @@
     ((:module tests
 	      :components
 	      ((:file "rt")
-	       (:uffi-test-source-file "uffi-c-test")
 	       (:file "package" :depends-on ("rt"))
+	       (:uffi-test-source-file "uffi-c-test" :depends-on ("package"))
 	       (:file "strtol" :depends-on ("package"))
 	       (:file "atoifl" :depends-on ("package"))
 	       (:file "getenv" :depends-on ("package"))
@@ -59,7 +80,7 @@
 	       (:file "union" :depends-on ("package"))
 	       (:file "arrays" :depends-on ("package"))
 	       (:file "structs" :depends-on ("package"))
-	       (:file "pointers" :depends-on ("package"))
+	       (:file "objects" :depends-on ("package"))
 	       (:file "time" :depends-on ("package"))
 	       (:file "foreign-loader" :depends-on ("package" "uffi-c-test"))
 	       (:file "uffi-c-test-lib" :depends-on ("foreign-loader"))

Modified: branches/xml-class-rework/thirdparty/uffi/uffi.asd
===================================================================
--- branches/xml-class-rework/thirdparty/uffi/uffi.asd	2006-10-22 16:40:58 UTC (rev 2024)
+++ branches/xml-class-rework/thirdparty/uffi/uffi.asd	2006-10-22 16:42:37 UTC (rev 2025)
@@ -7,19 +7,16 @@
 ;;;; Author:        Kevin M. Rosenberg
 ;;;; Date Started:  Aug 2002
 ;;;;
-;;;; $Id: uffi.asd,v 1.1 2004/06/23 08:27:10 hans Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 (defpackage #:uffi-system (:use #:asdf #:cl))
 (in-package #:uffi-system)
 
-#+(or allegro lispworks cmu mcl cormanlisp sbcl scl)
+#+(or allegro lispworks cmu openmcl digitool cormanlisp sbcl scl)
 (defsystem uffi
   :name "uffi"
   :author "Kevin Rosenberg "
@@ -28,22 +25,22 @@
   :licence "Lessor Lisp General Public License"
   :description "Universal Foreign Function Library for Common Lisp"
   :long-description "UFFI provides a universal foreign function interface (FFI) for Common Lisp. UFFI supports CMUCL, Lispworks, and AllegroCL."
-  
+
   :components
   ((:module :src
 	    :components
 	    ((:file "package")
 	     (:file "primitives" :depends-on ("package"))
-	     #+mcl (:file "readmacros-mcl" :depends-on ("package"))
+	     #+(or openmcl digitool) (:file "readmacros-mcl" :depends-on ("package"))
 	     (:file "objects" :depends-on ("primitives"))
-	     (:file "strings" :depends-on ("primitives" "functions" "aggregates" "objects"))
 	     (:file "aggregates" :depends-on ("primitives"))
+	     (:file "strings" :depends-on ("primitives" "functions" "aggregates" "objects"))
 	     (:file "functions" :depends-on ("primitives"))
 	     (:file "libraries" :depends-on ("package"))
 	     (:file "os" :depends-on ("package"))))
    ))
 
-#+(or allegro lispworks cmu mcl cormanlisp sbcl scl)
+#+(or allegro lispworks cmu openmcl digitool cormanlisp sbcl scl)
 (defmethod perform ((o test-op) (c (eql (find-system 'uffi))))
   (oos 'load-op 'uffi-tests)
   (oos 'test-op 'uffi-tests :force t))



From bknr at bknr.net  Sun Oct 22 16:43:35 2006
From: bknr at bknr.net (bknr at bknr.net)
Date: Sun, 22 Oct 2006 12:43:35 -0400 (EDT)
Subject: [bknr-cvs] r2026 -
	branches/xml-class-rework/thirdparty/cffi/uffi-compat
Message-ID: <20061022164335.7E41B1E001@common-lisp.net>

Author: hhubner
Date: 2006-10-22 12:43:35 -0400 (Sun, 22 Oct 2006)
New Revision: 2026

Modified:
   branches/xml-class-rework/thirdparty/cffi/uffi-compat/uffi-compat.lisp
Log:
We currently use both uffi and cffi, so cffi can't create an uffi nickname
for the cffi-uffi-compat package.


Modified: branches/xml-class-rework/thirdparty/cffi/uffi-compat/uffi-compat.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cffi/uffi-compat/uffi-compat.lisp	2006-10-22 16:42:37 UTC (rev 2025)
+++ branches/xml-class-rework/thirdparty/cffi/uffi-compat/uffi-compat.lisp	2006-10-22 16:43:35 UTC (rev 2026)
@@ -28,7 +28,7 @@
 ;;; Code borrowed from UFFI is Copyright (c) Kevin M. Rosenberg.
 
 (defpackage #:cffi-uffi-compat
-  (:nicknames #:uffi) ;; is this a good idea?
+  #+(or) (:nicknames #:uffi) ;; is this a good idea?
   (:use #:cl)
   (:export
 



From bknr at bknr.net  Sun Oct 22 16:45:34 2006
From: bknr at bknr.net (bknr at bknr.net)
Date: Sun, 22 Oct 2006 12:45:34 -0400 (EDT)
Subject: [bknr-cvs] r2027 - in branches/xml-class-rework/bknr/src: . web
Message-ID: <20061022164534.425C42B141@common-lisp.net>

Author: hhubner
Date: 2006-10-22 12:45:33 -0400 (Sun, 22 Oct 2006)
New Revision: 2027

Modified:
   branches/xml-class-rework/bknr/src/bknr.asd
   branches/xml-class-rework/bknr/src/web/tags.lisp
   branches/xml-class-rework/bknr/src/web/web-utils.lisp
Log:
Convert incoming paramter values to utf-8.
Do not create base href tag in generated html


Modified: branches/xml-class-rework/bknr/src/bknr.asd
===================================================================
--- branches/xml-class-rework/bknr/src/bknr.asd	2006-10-22 16:43:35 UTC (rev 2026)
+++ branches/xml-class-rework/bknr/src/bknr.asd	2006-10-22 16:45:33 UTC (rev 2027)
@@ -35,6 +35,7 @@
 		 :bknr-datastore
 		 :bknr-data-impex
 		 :kmrcl
+		 :iconv
 		 #+(not allegro)
 		 :acl-compat)
 

Modified: branches/xml-class-rework/bknr/src/web/tags.lisp
===================================================================
--- branches/xml-class-rework/bknr/src/web/tags.lisp	2006-10-22 16:43:35 UTC (rev 2026)
+++ branches/xml-class-rework/bknr/src/web/tags.lisp	2006-10-22 16:45:33 UTC (rev 2027)
@@ -183,7 +183,7 @@
 

Author: hhubner
Date: 2006-10-22 12:50:56 -0400 (Sun, 22 Oct 2006)
New Revision: 2028

Modified:
   branches/xml-class-rework/projects/bos/build.lisp
   branches/xml-class-rework/projects/bos/m2/bos.m2.asd
   branches/xml-class-rework/projects/bos/m2/config.lisp
   branches/xml-class-rework/projects/bos/m2/m2.lisp
   branches/xml-class-rework/projects/bos/m2/mail-generator.lisp
   branches/xml-class-rework/projects/bos/web/web.lisp
   branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.lisp
Log:
web server restartable in debug mode
vcard generation


Modified: branches/xml-class-rework/projects/bos/build.lisp
===================================================================
--- branches/xml-class-rework/projects/bos/build.lisp	2006-10-22 16:45:33 UTC (rev 2027)
+++ branches/xml-class-rework/projects/bos/build.lisp	2006-10-22 16:50:56 UTC (rev 2028)
@@ -28,7 +28,7 @@
 
 (defun start-webserver ()
   (apply #'bos.m2::reinit (read-configuration "m2.rc"))
-  (apply #'bos.web::reinit (read-configuration "web.rc"))
+  (apply #'bos.web::init (read-configuration "web.rc"))
   (bknr.cron::start-cron))
 
 (defun start-slime ()

Modified: branches/xml-class-rework/projects/bos/m2/bos.m2.asd
===================================================================
--- branches/xml-class-rework/projects/bos/m2/bos.m2.asd	2006-10-22 16:45:33 UTC (rev 2027)
+++ branches/xml-class-rework/projects/bos/m2/bos.m2.asd	2006-10-22 16:50:56 UTC (rev 2028)
@@ -1,7 +1,7 @@
 (in-package :cl-user)
 
 (asdf:defsystem :bos.m2
-    :depends-on (:bknr :bknr-modules :net.post-office)
+    :depends-on (:bknr :bknr-modules :net.post-office :cl-mime)
     :components ((:file "packages")
 		 (:file "config" :depends-on ("packages"))
 		 (:file "utils" :depends-on ("config"))

Modified: branches/xml-class-rework/projects/bos/m2/config.lisp
===================================================================
--- branches/xml-class-rework/projects/bos/m2/config.lisp	2006-10-22 16:45:33 UTC (rev 2027)
+++ branches/xml-class-rework/projects/bos/m2/config.lisp	2006-10-22 16:50:56 UTC (rev 2028)
@@ -66,4 +66,6 @@
 
 ;; Vertraege
 (defparameter *manual-contract-expiry-time* (* 42 24 3600))
-(defparameter *online-contract-expiry-time* (* 3600))
\ No newline at end of file
+(defparameter *online-contract-expiry-time* (* 3600))
+
+(defvar *website-url* "http://change-me")
\ No newline at end of file

Modified: branches/xml-class-rework/projects/bos/m2/m2.lisp
===================================================================
--- branches/xml-class-rework/projects/bos/m2/m2.lisp	2006-10-22 16:45:33 UTC (rev 2027)
+++ branches/xml-class-rework/projects/bos/m2/m2.lisp	2006-10-22 16:50:56 UTC (rev 2028)
@@ -363,9 +363,10 @@
     #-(or allegro cmu)
     ...))
 
-(defun reinit (&key delete directory)
+(defun reinit (&key delete directory website-url)
   (format t "~&; Startup Quadratmeterdatenbank...~%")
   (force-output)
+  (setf *website-url* website-url)
   (unless directory
     (error ":DIRECTORY parameter not set in m2.rc"))
   (when delete

Modified: branches/xml-class-rework/projects/bos/m2/mail-generator.lisp
===================================================================
--- branches/xml-class-rework/projects/bos/m2/mail-generator.lisp	2006-10-22 16:45:33 UTC (rev 2027)
+++ branches/xml-class-rework/projects/bos/m2/mail-generator.lisp	2006-10-22 16:50:56 UTC (rev 2028)
@@ -118,38 +118,37 @@
 				    contract-id))))
 
 (defun worldpay-callback-request-to-vcard (request)
-  (handler-case 
-      (with-query-params (request cartId
-				  transId
-				  MC_sponsorid
-				  MC_donationcert-yearly
-				  MC_gift
-				  name
-				  address
-				  postcode
-				  countryString
-				  email
-				  tel)
-	(with-output-to-string (s)
-	  (format s "BEGIN:VCARD~%")
-	  (format s "REV:~A~%" (format-date-time (get-universal-time) :xml-style t))
-	  (format s "VERSION:2.1~%")
-	  (format s "FN:~A~%" name)
-	  (format s "ADR;DOM;HOME;ENCODING=QUOTED-PRINTABLE:;;~A;;;~@[~A~];~A~%" (regex-replace-all #?r"\r?\n" address "=0D=0A") postcode countryString)
-	  (when tel
-	    (format s "TEL;WORK;HOME:~A~%" tel))
-	  (format s "EMAIL;PREF;INTERNET:~A~%" email)
-	  (format s "URL;WORK:~A/edit-sponsor/~A~%" worldpay-test::*website-url* MC_sponsorid)
-	  (format s "NOTE:Contract ID: ~A  Sponsor ID: ~A  WorldPay Transaction ID: ~A  Donationcert yearly: ~A  Gift: ~A~%"
-		  cartId
-		  MC_sponsorid
-		  transId
-		  (if MC_donationcert-yearly "Yes" "No")
-		  (if MC_gift "Yes" "No"))
-	  (format s "END:VCARD~%")))
-    (error (e)
-      (warn "vcard could not be generated: ~A~%" e)
-      "")))
+  (with-query-params (request cartId
+			      transId
+			      MC_sponsorid
+			      MC_donationcert-yearly
+			      MC_gift
+			      name
+			      address
+			      postcode
+			      country
+			      email
+			      tel)
+    (with-output-to-string (s)
+      (format s "BEGIN:VCARD~%")
+      (format s "REV:~A~%" (format-date-time (get-universal-time) :xml-style t))
+      (format s "VERSION:2.1~%")
+      (format s "FN;CHARSET=ISO-8859-1;ENCODING=QUOTED-PRINTABLE:~A~%" (cl-qprint:encode (iconv:iconv "UTF-8" "ISO-8859-1" name)))
+      (format s "ADR;DOM;HOME;CHARSET=ISO-8859-1;ENCODING=QUOTED-PRINTABLE:;;~A;;;~@[~A~];~A~%"
+	      (cl-qprint:encode (iconv:iconv "UTF-8" "ISO-8859-1" address) :encode-newlines t) postcode country)
+      (when tel
+	(format s "TEL;WORK;HOME:~A~%" tel))
+      (format s "EMAIL;PREF;INTERNET:~A~%" email)
+      (format s "URL;WORK:~A/edit-sponsor/~A~%" *website-url* MC_sponsorid)
+      (format s "NOTE;ENCODING=QUOTED-PRINTABLE:~A~%"
+	      (cl-qprint:encode (format nil "Contract ID: ~A~%Sponsor ID: ~A~%WorldPay Transaction ID: ~A~%Donationcert yearly: ~A~%Gift: ~A~%"
+					cartId
+					MC_sponsorid
+					transId
+					(if MC_donationcert-yearly "Yes" "No")
+					(if MC_gift "Yes" "No"))
+				:encode-newlines t))
+      (format s "END:VCARD~%"))))
 
 (defun mail-request-parameters (req subject)
   (let ((mime (make-instance 'cl-mime:multipart-mime
@@ -157,6 +156,8 @@
 			     :content (list (make-instance 'cl-mime:text-mime
 							   :type "text"
 							   :subtype "html"
+							   :charset "utf-8"
+							   :encoding :quoted-printable
 							   :content (format nil "
 
@@ -170,8 +171,22 @@
 												    (all-request-params req)))))
 					    (make-instance 'cl-mime:text-mime
 							   :type "text"
+							   :subtype "xml; name=\"sponsor.xml\""
+							   :charset "utf-8"
+							   :encoding :quoted-printable
+							   :content (format nil "
+
+ ~{<~A>~A~}
+
+"
+									    (apply #'append (mapcar #'(lambda (cons) (list (car cons) (cdr cons) (car cons)))
+												    (all-request-params req)))))
+					    (make-instance 'cl-mime:text-mime
+							   :type "text"
 							   :subtype "x-vcard; name=\"sponsor.vcf\""
+							   :charset "utf-8"
 							   :content (worldpay-callback-request-to-vcard req))))))
+    (format t "made mame~%")
     (send-system-mail :subject subject
 		      :content-type "multipart/mixed"
 		      :more-headers t

Modified: branches/xml-class-rework/projects/bos/web/web.lisp
===================================================================
--- branches/xml-class-rework/projects/bos/web/web.lisp	2006-10-22 16:45:33 UTC (rev 2027)
+++ branches/xml-class-rework/projects/bos/web/web.lisp	2006-10-22 16:50:56 UTC (rev 2028)
@@ -9,18 +9,33 @@
 
 (defvar *webserver* nil)
 
-(defun reinit (&key (port 8080) (listeners 1) (vhosts '("localhost")) website-directory website-url)
+(defvar *port*)
+(defvar *listeners*)
+(defvar *vhosts*)
+(defvar *website-directory*)
+(defvar *website-url*)
+
+(defun init (&key (port 8080) (listeners 1) (vhosts '("localhost")) website-directory website-url)
+  (setf *port* port)
+  (setf *listeners* listeners)
+  (setf *vhosts* vhosts)
+  (setf *website-url* website-url)
+  (setf *website-directory* website-directory)
+  (unless *website-directory*
+    (error ":website-directory not specified"))
+  (reinit))
+
+(defun reinit (&key debug)
   (format t "~&; Publishing BOS handlers.~%")
-  (cond 
-    (website-directory)
-    ((probe-file *default-wd*)
-     (setf website-directory *default-wd*))
-    (t
-     (error ":website-directory not specified")))
   (unpublish :all t)
-  (worldpay-test::publish-worldpay-test :website-directory website-directory
-					:vhosts vhosts
-					:website-url website-url)
-  (format t "~&; Starting aserve.~%")
+  (worldpay-test::publish-worldpay-test :website-directory *website-directory*
+					:vhosts *vhosts*
+					:website-url *website-url*)
+  (format t "~&; Starting aserve~@[ in debug mode~].~%" debug)
   (force-output)
-  (setq *webserver* (net.aserve:start :port port :listeners listeners)))
+  (setq *webserver*
+	(if debug
+	    (progn (net.aserve::debug-on :notrap)
+		   (net.aserve:start :port *port* :listeners 0))
+	    (progn (net.aserve::debug-off :all)
+		   (net.aserve:start :port *port* :listeners *listeners*)))))

Modified: branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.lisp
===================================================================
--- branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.lisp	2006-10-22 16:45:33 UTC (rev 2027)
+++ branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.lisp	2006-10-22 16:50:56 UTC (rev 2028)
@@ -24,7 +24,7 @@
 
 (defmethod find-template-pathname ((handler worldpay-template-handler) template-name &key request)
   (when (scan #?r"(^|.*/)handle-sale" template-name)
-    (with-query-params (request cartId email name address country transStatus lang MC_gift MC_donationcert-yearly testMode)
+    (with-query-params (request cartId email name address country transStatus lang MC_gift MC_donationcert-yearly testMode)      
       (unless (website-supports-language lang)
 	(setf lang *default-language*))
       (let ((contract (get-contract (parse-integer cartId))))



From bknr at bknr.net  Sun Oct 22 17:00:41 2006
From: bknr at bknr.net (bknr at bknr.net)
Date: Sun, 22 Oct 2006 13:00:41 -0400 (EDT)
Subject: [bknr-cvs] r2029 - branches/xml-class-rework/projects/bos/m2
Message-ID: <20061022170041.57259751B5@common-lisp.net>

Author: hhubner
Date: 2006-10-22 13:00:41 -0400 (Sun, 22 Oct 2006)
New Revision: 2029

Modified:
   branches/xml-class-rework/projects/bos/m2/bos.m2.asd
Log:
Use iconv package


Modified: branches/xml-class-rework/projects/bos/m2/bos.m2.asd
===================================================================
--- branches/xml-class-rework/projects/bos/m2/bos.m2.asd	2006-10-22 16:50:56 UTC (rev 2028)
+++ branches/xml-class-rework/projects/bos/m2/bos.m2.asd	2006-10-22 17:00:41 UTC (rev 2029)
@@ -1,7 +1,7 @@
 (in-package :cl-user)
 
 (asdf:defsystem :bos.m2
-    :depends-on (:bknr :bknr-modules :net.post-office :cl-mime)
+    :depends-on (:bknr :bknr-modules :net.post-office :cl-mime :iconv)
     :components ((:file "packages")
 		 (:file "config" :depends-on ("packages"))
 		 (:file "utils" :depends-on ("config"))



From bknr at bknr.net  Sun Oct 22 17:18:40 2006
From: bknr at bknr.net (bknr at bknr.net)
Date: Sun, 22 Oct 2006 13:18:40 -0400 (EDT)
Subject: [bknr-cvs] r2030 - branches/xml-class-rework/projects/bos
Message-ID: <20061022171840.B4F61316A@common-lisp.net>

Author: hhubner
Date: 2006-10-22 13:18:39 -0400 (Sun, 22 Oct 2006)
New Revision: 2030

Modified:
   branches/xml-class-rework/projects/bos/build.lisp
Log:
Reinitialize shared libs while starting up in (presumably) original
order so that dependencies between libraries are correctly caught.


Modified: branches/xml-class-rework/projects/bos/build.lisp
===================================================================
--- branches/xml-class-rework/projects/bos/build.lisp	2006-10-22 17:00:41 UTC (rev 2029)
+++ branches/xml-class-rework/projects/bos/build.lisp	2006-10-22 17:18:39 UTC (rev 2030)
@@ -35,7 +35,7 @@
   (swank::create-swank-server 4005 :spawn #'swank::simple-announce-function t))
 
 (defun reload-global-table ()
-  (loop for lib-entry in sys::*global-table*
+  (loop for lib-entry in (reverse sys::*global-table*)
 	for (sap . lib-path) = lib-entry
 	when lib-path
 	do (let ((new-sap (sys::dlopen (namestring lib-path)



From bknr at bknr.net  Mon Oct 23 05:00:44 2006
From: bknr at bknr.net (bknr at bknr.net)
Date: Mon, 23 Oct 2006 01:00:44 -0400 (EDT)
Subject: [bknr-cvs] r2031 - branches/xml-class-rework/thirdparty/iconv
Message-ID: <20061023050044.CE539671AC@common-lisp.net>

Author: hhubner
Date: 2006-10-23 01:00:44 -0400 (Mon, 23 Oct 2006)
New Revision: 2031

Modified:
   branches/xml-class-rework/thirdparty/iconv/iconv.lisp
Log:
modified for different errno handling in cmucl19c


Modified: branches/xml-class-rework/thirdparty/iconv/iconv.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/iconv/iconv.lisp	2006-10-22 17:18:39 UTC (rev 2030)
+++ branches/xml-class-rework/thirdparty/iconv/iconv.lisp	2006-10-23 05:00:44 UTC (rev 2031)
@@ -12,13 +12,15 @@
 (cffi-uffi-compat:load-foreign-library "/usr/lib/libc.so")
 (cffi-uffi-compat:load-foreign-library "/usr/local/lib/libiconv.so")
    
-#-:sbcl
+#-sbcl
 (cffi-uffi-compat:def-foreign-var ("errno" errno) :int "iconv")
 
 (defun get-errno ()
-  #-:sbcl
+  #-(or sbcl cmu19c)
   errno
-  #+:sbcl
+  #+cmu19c
+  (unix:unix-errno)
+  #+sbcl
   (sb-alien:get-errno)
   )
 



From bknr at bknr.net  Mon Oct 23 05:11:43 2006
From: bknr at bknr.net (bknr at bknr.net)
Date: Mon, 23 Oct 2006 01:11:43 -0400 (EDT)
Subject: [bknr-cvs] r2032 - branches/xml-class-rework/thirdparty/cl-qprint
Message-ID: <20061023051143.4BF397208D@common-lisp.net>

Author: hhubner
Date: 2006-10-23 01:11:42 -0400 (Mon, 23 Oct 2006)
New Revision: 2032

Modified:
   branches/xml-class-rework/thirdparty/cl-qprint/base.lisp
Log:
Properly generate crlf


Modified: branches/xml-class-rework/thirdparty/cl-qprint/base.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cl-qprint/base.lisp	2006-10-23 05:00:44 UTC (rev 2031)
+++ branches/xml-class-rework/thirdparty/cl-qprint/base.lisp	2006-10-23 05:11:42 UTC (rev 2032)
@@ -102,7 +102,7 @@
 	;; Ensure newlines are CR-LF
 	((char= c #\newline)
 	 (if encode-newlines
-	   (format out-stream "=0A=0D")
+	   (format out-stream "=0D=0A")
 	   (cr-lf out-stream))
 	 (setf last-line-break position))
 



From bknr at bknr.net  Mon Oct 23 05:53:29 2006
From: bknr at bknr.net (bknr at bknr.net)
Date: Mon, 23 Oct 2006 01:53:29 -0400 (EDT)
Subject: [bknr-cvs] r2033 - branches/xml-class-rework/thirdparty/iconv
Message-ID: <20061023055329.C69DE2B0E1@common-lisp.net>

Author: hhubner
Date: 2006-10-23 01:53:29 -0400 (Mon, 23 Oct 2006)
New Revision: 2033

Modified:
   branches/xml-class-rework/thirdparty/iconv/iconv.lisp
Log:
Fix error handling


Modified: branches/xml-class-rework/thirdparty/iconv/iconv.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/iconv/iconv.lisp	2006-10-23 05:11:42 UTC (rev 2032)
+++ branches/xml-class-rework/thirdparty/iconv/iconv.lisp	2006-10-23 05:53:29 UTC (rev 2033)
@@ -81,13 +81,11 @@
 				     in-ptr inbytesleft
 				     out-ptr outbytesleft)
 			     #xffffffff)
-		      (if (= (get-errno) EILSEQ)
+		      (if (find (get-errno) (list EILSEQ EINVAL) :test #'eql)
 			  (if error-p
-			      (error "invalid multibyte(~X)."
-				     (cffi-uffi-compat:deref-array inbuffer (cffi-uffi-compat::convert-uffi-type :unsigned-byte) (current)))
+			      (error "invalid multibyte character (0x~X)." (cffi:mem-aref inbuffer :unsigned-char (current)))
 			      (progn
-				(setf (cffi-uffi-compat:deref-array inbuffer (cffi-uffi-compat::convert-uffi-type :unsigned-byte) (current))
-				      error-value)
+				(setf (cffi:mem-aref inbuffer :unsigned-char (current)) error-value)
 				(self)))
 			  (error "unexpected iconv error ~A" (get-errno))))))
 	       (self))



From bknr at bknr.net  Mon Oct 23 06:05:39 2006
From: bknr at bknr.net (bknr at bknr.net)
Date: Mon, 23 Oct 2006 02:05:39 -0400 (EDT)
Subject: [bknr-cvs] r2034 - branches/xml-class-rework/projects/bos/tools
Message-ID: <20061023060539.AC7C670257@common-lisp.net>

Author: hhubner
Date: 2006-10-23 02:05:39 -0400 (Mon, 23 Oct 2006)
New Revision: 2034

Modified:
   branches/xml-class-rework/projects/bos/tools/wp-callpack-redirect.pl
Log:
Pass content-type to handling host.


Modified: branches/xml-class-rework/projects/bos/tools/wp-callpack-redirect.pl
===================================================================
--- branches/xml-class-rework/projects/bos/tools/wp-callpack-redirect.pl	2006-10-23 05:53:29 UTC (rev 2033)
+++ branches/xml-class-rework/projects/bos/tools/wp-callpack-redirect.pl	2006-10-23 06:05:39 UTC (rev 2034)
@@ -18,6 +18,8 @@
 
 	my $is_test = ($content =~ /testMode=100/);
 	my $host = $is_test ? "test.createrainforest.org" : "createrainforest.org";
+
+	$ua->default_header('Content-Type', $request->header('Content-Type'));
 	my $response = $ua->get("http://" . $host . ":8080/handle-sale?" . $content);
 	$client->send_response($response);
 	print "Redirected request to ", ($is_test ? "TEST" : "PRODUCTION"), " system\n";



From bknr at bknr.net  Mon Oct 23 08:14:41 2006
From: bknr at bknr.net (bknr at bknr.net)
Date: Mon, 23 Oct 2006 04:14:41 -0400 (EDT)
Subject: [bknr-cvs] r2035 - in branches/xml-class-rework/projects/bos: m2
	worldpay-test
Message-ID: <20061023081441.C05BE6D029@common-lisp.net>

Author: hhubner
Date: 2006-10-23 04:14:40 -0400 (Mon, 23 Oct 2006)
New Revision: 2035

Modified:
   branches/xml-class-rework/projects/bos/m2/mail-generator.lisp
   branches/xml-class-rework/projects/bos/m2/packages.lisp
   branches/xml-class-rework/projects/bos/worldpay-test/tags.lisp
   branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.lisp
Log:
mail vcards of manual sales
functions renamed, api enhanced


Modified: branches/xml-class-rework/projects/bos/m2/mail-generator.lisp
===================================================================
--- branches/xml-class-rework/projects/bos/m2/mail-generator.lisp	2006-10-23 06:05:39 UTC (rev 2034)
+++ branches/xml-class-rework/projects/bos/m2/mail-generator.lisp	2006-10-23 08:14:40 UTC (rev 2035)
@@ -10,8 +10,14 @@
 To: ~A
 Subject: ~A
 Content-Type: ~A
-~@[~%~]~A"
-		     (format-date-time (get-universal-time) :mail-style t) *mail-sender* to subject content-type (not more-headers) text)))
+~@[~*~%~]~A"
+		     (format-date-time (get-universal-time) :mail-style t)
+		     *mail-sender*
+		     to
+		     subject
+		     content-type
+		     (not more-headers)
+		     text)))
   
 (defun mail-info-request (email)
   (send-system-mail :subject "Mailinglisten-Eintrag"
@@ -26,7 +32,7 @@
     (send-system-mail :subject #?"Druckauftrag fuer Spender-Urkunde"
 		      :text #?"Bitte die folgende Urkunde ausdrucken und versenden:
 
-http://create-rainforest.org/print-certificate/$(contract-id)
+$(*website-url*)/print-certificate/$(contract-id)
 
 Versandadresse:
 
@@ -75,27 +81,100 @@
 
 Das Team von BOS Deutschland e.V.")))
 
-(defun mail-transfer-indication (contract-id vorname name strasse plz ort email telefon mail-certificate donationcert-yearly)
-  (let ((contract (store-object-with-id (parse-integer contract-id))))
-    (send-system-mail :subject #?"Ueberweisungsformular fuer Contract-ID $(contract-id)"
-		      :content-type "text/html; charset=UTF-8"
-		      :text (format nil "
+(defun make-vcard (&key contract-id sponsor-id worldpay-transaction-id
+		   donationcert-yearly gift
+		   vorname nachname
+		   name
+		   address postcode country
+		   strasse ort
+		   email tel)
+  (with-output-to-string (s)
+    (format s "BEGIN:VCARD~%")
+    (format s "REV:~A~%" (format-date-time (get-universal-time) :xml-style t))
+    (format s "VERSION:2.1~%")
+    (if name
+	(format s "FN;CHARSET=ISO-8859-1;ENCODING=QUOTED-PRINTABLE:~A~%" (cl-qprint:encode (iconv:iconv "UTF-8" "ISO-8859-1" name)))
+	(format s "FN;CHARSET=ISO-8859-1;ENCODING=QUOTED-PRINTABLE:~A ~A~%"
+		(cl-qprint:encode (iconv:iconv "UTF-8" "ISO-8859-1" vorname))
+		(cl-qprint:encode (iconv:iconv "UTF-8" "ISO-8859-1" nachname))))
+    (when vorname
+      (format s "N;CHARSET=ISO-8859-1;ENCODING=QUOTED-PRINTABLE:~A;~A;;;~%"
+	      (cl-qprint:encode (iconv:iconv "UTF-8" "ISO-8859-1" nachname))
+	      (cl-qprint:encode (iconv:iconv "UTF-8" "ISO-8859-1" vorname))))
+    (when address
+      (format s "ADR;DOM;HOME;CHARSET=ISO-8859-1;ENCODING=QUOTED-PRINTABLE:;;~A;;;~@[~A~];~A~%"
+	      (cl-qprint:encode (iconv:iconv "UTF-8" "ISO-8859-1" address) :encode-newlines t) postcode country))
+    (when strasse
+      (format s "ADR;DOM;HOME;CHARSET=ISO-8859-1;ENCODING=QUOTED-PRINTABLE:;;~A;~A;;~A;~@[~A~]~%"
+	      (cl-qprint:encode (iconv:iconv "UTF-8" "ISO-8859-1" strasse))
+	      (cl-qprint:encode (iconv:iconv "UTF-8" "ISO-8859-1" ort))
+	      postcode country))
+    (when tel
+      (format s "TEL;WORK;HOME:~A~%" tel))
+    (format s "EMAIL;PREF;INTERNET:~A~%" email)
+    (format s "URL;WORK:~A/edit-sponsor/~A~%" *website-url* sponsor-id)
+    (format s "NOTE;ENCODING=QUOTED-PRINTABLE:~A~%"
+	    (cl-qprint:encode (format nil "Contract ID: ~A~%Sponsor ID: ~A~%~@[WorldPay Transaction ID: ~A~%~]Donationcert yearly: ~A~%Gift: ~A~%"
+				      contract-id
+				      sponsor-id
+				      worldpay-transaction-id
+				      (if donationcert-yearly "Yes" "No")
+				      (if gift "Yes" "No"))
+			      :encode-newlines t))
+    (format s "END:VCARD~%")))
+
+(defun worldpay-callback-request-to-vcard (request)
+  (with-query-params (request cartId
+			      transId
+			      MC_sponsorid
+			      MC_donationcert-yearly
+			      MC_gift
+			      name
+			      address
+			      postcode
+			      country
+			      email
+			      tel)
+    (make-vcard :contract-id cartId
+		:sponsor-id MC_sponsorid
+		:worldpay-transaction-id transId
+		:donationcert-yearly MC_donationcert-yearly
+		:gift MC_gift
+		:name name
+		:address address
+		:postcode postcode
+		:country country
+		:email email
+		:tel tel)))
+
+(defun mail-manual-sponsor-data (req)
+  (with-query-params (req contract-id vorname name strasse plz ort email telefon mail-certificate donationcert-yearly)
+    (let* ((contract (store-object-with-id (parse-integer contract-id)))
+	   (sponsor-id (store-object-id (contract-sponsor contract)))
+	   (mime (make-instance 'multipart-mime
+				:subtype "mixed"
+				:content (list (make-instance 'text-mime
+							      :type "text"
+							      :subtype "html"
+							      :charset "utf-8"
+							      :encoding :quoted-printable
+							      :content (format nil "
 Ueberweisungsformulardaten:

  
  
    
    
-    
-    
-    
-    
-    
-    
-    
-    
-    ~@[
+    
+    
+    
+    
+    
+    
+    
+    
+    ~@[
     
-    
-    ~]
+    
+    ~]
    Contract-ID ~@[~a~]
Anzahl sqm ~a
Vorname ~@[~a~]
Name ~@[~a~]
Strasse ~@[~a~]
PLZ ~@[~a~]
Ort ~@[~a~]
Email ~@[~a~]
Telefon ~@[~a~]
Contract-ID ~@[~A~]
Anzahl sqm ~A
Vorname ~@[~A~]
Name ~@[~A~]
Strasse ~@[~A~]
PLZ ~@[~A~]
Ort ~@[~A~]
Email ~@[~A~]
Telefon ~@[~A~]
Urkunde per Post ~a
Spendenbescheinigung am Jahresende ~a
Urkunde per Post ~A
Spendenbescheinigung am Jahresende ~A
    Email & Adresse fuer Cut&Paste:
    @@ -105,60 +184,66 @@
 ~A
 ~A ~A
    
-   Link zum Sponsor-Datensatz
+   Link zum Sponsor-Datensatz
  
 
 "
-				    contract-id
-				    (length (contract-m2s contract))
-				    vorname name strasse plz ort email telefon
-				    (if mail-certificate "ja" "nein")
-				    (if donationcert-yearly "ja" "nein")
-				    email vorname name strasse plz ort
-				    contract-id))))
+									     contract-id
+									     (length (contract-m2s contract))
+									     vorname name strasse plz ort email telefon
+									     (if mail-certificate "ja" "nein")
+									     (if donationcert-yearly "ja" "nein")
+									     email vorname name
+									     strasse plz ort
+									     *website-url* contract-id))
+					       (make-instance 'text-mime
+							      :type "text"
+							      :subtype (format nil "xml; name=\"contract-~A.xml\"" contract-id)
+							      :charset "utf-8"
+							      :encoding :quoted-printable
+							      :content (format nil "
+
+ ~{<~A>~A~}
+
+"
+									       (apply #'append (mapcar #'(lambda (cons)
+									       (list (car cons)
+										     (if (find #\Newline (cdr cons))
+											 (format nil "" (cdr cons))
+											 (cdr cons))
+										     (car cons)))
+												       (all-request-params req)))))
+					       (make-instance 'text-mime
+							      :type "text"
+							      :subtype (format nil "x-vcard; name=\"contract-~A.vcf\"" contract-id)
+							      :charset "utf-8"
+							      :content (make-vcard :contract-id contract-id
+										   :sponsor-id sponsor-id
+										   :donationcert-yearly donationcert-yearly
+										   :vorname vorname
+										   :nachname name
+										   :strasse strasse
+										   :postcode plz
+										   :ort ort
+										   :email email
+										   :tel telefon))))))
+      (send-system-mail :subject (format nil "Ueberweisungsformular-Spenderdaten - Sponsor-ID ~D Contract-ID ~D"
+					 sponsor-id contract-id)
+			:content-type "multipart/mixed"
+			:more-headers t
+			:text (with-output-to-string (s) (print-mime s mime t t))))))
 
-(defun worldpay-callback-request-to-vcard (request)
-  (with-query-params (request cartId
-			      transId
-			      MC_sponsorid
-			      MC_donationcert-yearly
-			      MC_gift
-			      name
-			      address
-			      postcode
-			      country
-			      email
-			      tel)
-    (with-output-to-string (s)
-      (format s "BEGIN:VCARD~%")
-      (format s "REV:~A~%" (format-date-time (get-universal-time) :xml-style t))
-      (format s "VERSION:2.1~%")
-      (format s "FN;CHARSET=ISO-8859-1;ENCODING=QUOTED-PRINTABLE:~A~%" (cl-qprint:encode (iconv:iconv "UTF-8" "ISO-8859-1" name)))
-      (format s "ADR;DOM;HOME;CHARSET=ISO-8859-1;ENCODING=QUOTED-PRINTABLE:;;~A;;;~@[~A~];~A~%"
-	      (cl-qprint:encode (iconv:iconv "UTF-8" "ISO-8859-1" address) :encode-newlines t) postcode country)
-      (when tel
-	(format s "TEL;WORK;HOME:~A~%" tel))
-      (format s "EMAIL;PREF;INTERNET:~A~%" email)
-      (format s "URL;WORK:~A/edit-sponsor/~A~%" *website-url* MC_sponsorid)
-      (format s "NOTE;ENCODING=QUOTED-PRINTABLE:~A~%"
-	      (cl-qprint:encode (format nil "Contract ID: ~A~%Sponsor ID: ~A~%WorldPay Transaction ID: ~A~%Donationcert yearly: ~A~%Gift: ~A~%"
-					cartId
-					MC_sponsorid
-					transId
-					(if MC_donationcert-yearly "Yes" "No")
-					(if MC_gift "Yes" "No"))
-				:encode-newlines t))
-      (format s "END:VCARD~%"))))
-
-(defun mail-request-parameters (req subject)
-  (let ((mime (make-instance 'cl-mime:multipart-mime
-			     :subtype "mixed"
-			     :content (list (make-instance 'cl-mime:text-mime
-							   :type "text"
-							   :subtype "html"
-							   :charset "utf-8"
-							   :encoding :quoted-printable
-							   :content (format nil "
+(defun mail-worldpay-sponsor-data (req)
+  (with-query-params (req cartId)
+    (let* ((contract (store-object-with-id (parse-integer cartId)))
+	   (mime (make-instance 'multipart-mime
+				:subtype "mixed"
+				:content (list (make-instance 'text-mime
+							      :type "text"
+							      :subtype "html"
+							      :charset "utf-8"
+							      :encoding :quoted-printable
+							      :content (format nil "
 
@@ -167,27 +252,35 @@
  ~{~}
 
  
   Parameter
~A ~A
 "
-									    (apply #'append (mapcar #'(lambda (cons) (list (car cons) (cdr cons)))
-												    (all-request-params req)))))
-					    (make-instance 'cl-mime:text-mime
-							   :type "text"
-							   :subtype "xml; name=\"sponsor.xml\""
-							   :charset "utf-8"
-							   :encoding :quoted-printable
-							   :content (format nil "
+									       (apply #'append (mapcar #'(lambda (cons) (list (car cons) (cdr cons)))
+												       (sort (all-request-params req)
+													     #'string-lessp
+													     :key #'car)))))
+					       (make-instance 'text-mime
+							      :type "text"
+							      :subtype (format nil "xml; name=\"contract-~A.xml\"" (store-object-id contract))
+							      :charset "utf-8"
+							      :encoding :quoted-printable
+							      :content (format nil "
 
  ~{<~A>~A~}
 
 "
-									    (apply #'append (mapcar #'(lambda (cons) (list (car cons) (cdr cons) (car cons)))
-												    (all-request-params req)))))
-					    (make-instance 'cl-mime:text-mime
-							   :type "text"
-							   :subtype "x-vcard; name=\"sponsor.vcf\""
-							   :charset "utf-8"
-							   :content (worldpay-callback-request-to-vcard req))))))
-    (format t "made mame~%")
-    (send-system-mail :subject subject
-		      :content-type "multipart/mixed"
-		      :more-headers t
-		      :text (with-output-to-string (s) (cl-mime:print-mime s mime t t)))))
+									       (apply #'append (mapcar #'(lambda (cons)
+									       (list (car cons)
+										     (if (find #\Newline (cdr cons))
+											 (format nil "" (cdr cons))
+											 (cdr cons))
+										     (car cons)))
+												       (all-request-params req)))))
+					       (make-instance 'text-mime
+							      :type "text"
+							      :subtype (format nil "x-vcard; name=\"contract-~A.vcf\"" (store-object-id contract))
+							      :charset "utf-8"
+							      :content (worldpay-callback-request-to-vcard req))))))
+      (send-system-mail :subject (format nil "Online-Spenderdaten - Sponsor-ID ~D Contract-ID ~D"
+					 (store-object-id (contract-sponsor contract))
+					 (store-object-id contract))
+			:content-type "multipart/mixed"
+			:more-headers t
+			:text (with-output-to-string (s) (print-mime s mime t t))))))

Modified: branches/xml-class-rework/projects/bos/m2/packages.lisp
===================================================================
--- branches/xml-class-rework/projects/bos/m2/packages.lisp	2006-10-23 06:05:39 UTC (rev 2034)
+++ branches/xml-class-rework/projects/bos/m2/packages.lisp	2006-10-23 08:14:40 UTC (rev 2035)
@@ -38,6 +38,7 @@
 	:bos.m2.config
 	:net.post-office
 	:cxml
+	:cl-mime
 	:cl-gd)
   (:shadowing-import-from :cl-interpol #:quote-meta-chars)
   (:export #:m2-store
@@ -178,9 +179,9 @@
 
 	   #:mail-fiscal-certificate-to-office
 	   #:mail-instructions-to-sponsor
-	   #:mail-transfer-indication
 	   #:mail-info-request
-	   #:mail-request-parameters
+	   #:mail-manual-sponsor-data
+	   #:mail-worldpay-sponsor-data
 
 	   #:*cert-download-directory*))
 

Modified: branches/xml-class-rework/projects/bos/worldpay-test/tags.lisp
===================================================================
--- branches/xml-class-rework/projects/bos/worldpay-test/tags.lisp	2006-10-23 06:05:39 UTC (rev 2034)
+++ branches/xml-class-rework/projects/bos/worldpay-test/tags.lisp	2006-10-23 08:14:40 UTC (rev 2035)
@@ -100,8 +100,7 @@
   (mapc #'emit-template-node children))
 
 (define-bknr-tag mail-transfer ()
-  (with-query-params ((get-template-var :request) contract-id vorname name strasse plz ort email telefon mail-certificate donationcert-yearly)
-    (mail-transfer-indication contract-id vorname name strasse plz ort email telefon mail-certificate donationcert-yearly)))
+  (mail-manual-sponsor-data (get-template-var :request)))
 
 (define-bknr-tag when-certificate (&key children)
   (let ((sponsor (bknr-request-user (get-template-var :request))))

Modified: branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.lisp
===================================================================
--- branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.lisp	2006-10-23 06:05:39 UTC (rev 2034)
+++ branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.lisp	2006-10-23 08:14:40 UTC (rev 2035)
@@ -36,14 +36,10 @@
 	  ((equal "C" transStatus)
 	   (setf template-name #?"/$(lang)/sponsor_canceled"))
 	  ((< (contract-price contract) *mail-certificate-threshold*)
-	   (mail-request-parameters request (format nil "Online-Spenderdaten - Sponsor-ID ~D Contract-ID ~D"
-						    (store-object-id (contract-sponsor contract))
-						    (store-object-id contract)))
+	   (mail-worldpay-sponsor-data request)
 	   (setf template-name #?"/$(lang)/quittung"))
 	  (t
-	   (mail-request-parameters request (format nil "Online-Spenderdaten - Sponsor-ID ~D Contract-ID ~D"
-						    (store-object-id (contract-sponsor contract))
-						    (store-object-id contract)))
+	   (mail-worldpay-sponsor-data request)
 	   (when (<= *mail-fiscal-certificate-threshold* (contract-price contract))
 	     (mail-fiscal-certificate-to-office contract name address country))
 	   (setf template-name (if (and MC_gift (equal MC_gift "1")) #?"/$(lang)/versand_geschenk" #?"/$(lang)/versand_info")))))))



From bknr at bknr.net  Mon Oct 23 08:15:37 2006
From: bknr at bknr.net (bknr at bknr.net)
Date: Mon, 23 Oct 2006 04:15:37 -0400 (EDT)
Subject: [bknr-cvs] r2036 - branches/xml-class-rework/thirdparty/cl-mime
Message-ID: <20061023081537.1399F710F8@common-lisp.net>

Author: hhubner
Date: 2006-10-23 04:15:36 -0400 (Mon, 23 Oct 2006)
New Revision: 2036

Modified:
   branches/xml-class-rework/thirdparty/cl-mime/classes.lisp
Log:
Fix type declarations for epilogue and prologue (not string, but string
or nil)


Modified: branches/xml-class-rework/thirdparty/cl-mime/classes.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cl-mime/classes.lisp	2006-10-23 08:14:40 UTC (rev 2035)
+++ branches/xml-class-rework/thirdparty/cl-mime/classes.lisp	2006-10-23 08:15:36 UTC (rev 2036)
@@ -107,13 +107,11 @@
    (prologue
     :accessor prologue
     :initform nil
-    :initarg :prologue
-    :type string)
+    :initarg :prologue)
    (epilogue
     :accessor epilogue
     :initform nil
-    :initarg :epilogue
-    :type string))
+    :initarg :epilogue))
   (:documentation "Multipart Mime Object Representation"))
     
 ;;; This boundary contains text which should never appear in the



From bknr at bknr.net  Mon Oct 23 11:10:25 2006
From: bknr at bknr.net (bknr at bknr.net)
Date: Mon, 23 Oct 2006 07:10:25 -0400 (EDT)
Subject: [bknr-cvs] r2037 - branches/xml-class-rework/thirdparty/cl-qprint
Message-ID: <20061023111025.0D79876001@common-lisp.net>

Author: hhubner
Date: 2006-10-23 07:10:22 -0400 (Mon, 23 Oct 2006)
New Revision: 2037

Modified:
   branches/xml-class-rework/thirdparty/cl-qprint/base.lisp
Log:
Throw error if unexpected type of input passed to encode/decode.


Modified: branches/xml-class-rework/thirdparty/cl-qprint/base.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cl-qprint/base.lisp	2006-10-23 08:15:36 UTC (rev 2036)
+++ branches/xml-class-rework/thirdparty/cl-qprint/base.lisp	2006-10-23 11:10:22 UTC (rev 2037)
@@ -33,7 +33,7 @@
 from INPUT and produces the equivalent decoded string"
   (let ((out-stream (make-string-output-stream))
 	(in-stream
-	 (typecase input
+	 (etypecase input
 	   (string (make-string-input-stream input))
 	   (stream input))))
     (do ((char (read-char in-stream nil 'eof)
@@ -73,7 +73,7 @@
 a quoted-printable encoded string"
   (let ((out-stream (make-string-output-stream))
 	(in-stream
-	 (typecase input
+	 (etypecase input
 	   (string (make-string-input-stream input))
 	   (stream input)))
 	(last-line-break 0)



From bknr at bknr.net  Mon Oct 23 11:45:32 2006
From: bknr at bknr.net (bknr at bknr.net)
Date: Mon, 23 Oct 2006 07:45:32 -0400 (EDT)
Subject: [bknr-cvs] r2038 - in branches/xml-class-rework/projects/bos: m2
	worldpay-test
Message-ID: <20061023114532.92376232C8@common-lisp.net>

Author: hhubner
Date: 2006-10-23 07:45:32 -0400 (Mon, 23 Oct 2006)
New Revision: 2038

Modified:
   branches/xml-class-rework/projects/bos/m2/mail-generator.lisp
   branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.lisp
Log:
copy-list before sorting


Modified: branches/xml-class-rework/projects/bos/m2/mail-generator.lisp
===================================================================
--- branches/xml-class-rework/projects/bos/m2/mail-generator.lisp	2006-10-23 11:10:22 UTC (rev 2037)
+++ branches/xml-class-rework/projects/bos/m2/mail-generator.lisp	2006-10-23 11:45:32 UTC (rev 2038)
@@ -207,11 +207,11 @@
 
 "
 									       (apply #'append (mapcar #'(lambda (cons)
-									       (list (car cons)
-										     (if (find #\Newline (cdr cons))
-											 (format nil "" (cdr cons))
-											 (cdr cons))
-										     (car cons)))
+													   (list (car cons)
+														 (if (find #\Newline (cdr cons))
+														     (format nil "" (cdr cons))
+														     (cdr cons))
+														 (car cons)))
 												       (all-request-params req)))))
 					       (make-instance 'text-mime
 							      :type "text"
@@ -253,7 +253,7 @@
 
@@ -113,22 +190,66 @@
 ~A
 ~A ~A
    
-$(address)
-$(postcode)
-$(country)
-
-$(error-message)
-
-$(error-message)
-
-$(error-message)
-

' @@ -381,8 +382,8 @@ + '

' + msg('gesponsort') + ':	' + n_profil['anzahl'] - + ' m??
' + msg('seit') + ':	' - + n_qm[1]['datum'] + + ' m??
' + + msg('seit') + ':	' + n_profil.contracts[0].date + '

' + n_profil['nachricht'] @@ -390,77 +391,90 @@ } // Inhalt der Ueberschrift und des Infotextes werden gesetzt document.getElementById("qmLaden").style.visibility = "hidden"; - if (n_qm[1]) { + if (n_profil.contracts) { document.getElementById("Ueberschrift").innerHTML = msg("Verkaufte m??"); } else { document.getElementById("Ueberschrift").innerHTML = msg("zu verkaufen!"); } document.getElementById("qmInfoText").innerHTML = text; - n_qm_erzeugen(); + display_selected_contract(); } else { // wenn der Datensatz noch nicht komplett geladen ist wird der timer eroeht und die Funktion nochmal gestartet timer++; if (timer < 100) { setTimeout("n_qm_warten()", 100); } else { - document.getElementById("qmLaden").style.visibility = "hidden"; schreibe_debugger(" -> Nachbar-Quadratmeter konnten nicht geladen werden"); + document.getElementById("qmLaden").style.visibility = "hidden"; dbg(" -> Nachbar-Quadratmeter konnten nicht geladen werden"); } } return true; } -function n_qm_erzeugen() { - // Erzeugen der Nachbarquadratmeter - // alte qm loeschen - if (n_zeilen > 0) { - for (var i = 1; i < n_zeilen; i++) { - var loeschen = eval("document.getElementById('n_qm" + i + "')"); - document.getElementById("qmAusschnitt").removeChild(loeschen); - } - schreibe_debugger(" -> " + n_zeilen + " zeilen geloescht"); +function load_contract_image(contract, image, factor, color) +{ + var container = image.parentNode; + + if (!color) { + color = 'ffff00'; } - // aktuelle qm einzeichnen - n_zeilen = 1; - objekt = n_qm[1]; - if (objekt['qm_x']) { - schreibe_debugger(" -> Es sollen " + objekt['qm_x'].length + " erzeugt werden"); - for (i=1; i < objekt['qm_x'].length; i++) { - - // neue Ebene erstellen, Ebene ist abhaengig von - var neueebene=document.createElement("DIV"); - document.getElementById("qmAusschnitt").appendChild(neueebene); - - // Testen ob Icon links oder rechts steht --> Ebene mu? um 150 px versetzt werden oder nicht - var x = parseInt(Math.round(objekt['qm_x'][i] - x_anf) * 5); - var y = parseInt(Math.round(objekt['qm_y'][i] - y_anf) * 5); - var width=5; - while (objekt['qm_y'][i] == objekt['qm_y'][(i + 1)]) { - width += 5; - i++; - } - // definieren der Styles - neueebene.style.position="absolute"; - neueebene.style.left = x + "px"; - neueebene.style.top = y + "px"; - neueebene.style.height = "5px"; - neueebene.style.width = width + "px"; - neueebene.style.zIndex ="9"; - neueebene.style.visibility = "inherit"; - neueebene.id = "n_qm" + n_zeilen; - neueebene.align = "left"; - neueebene.innerHTML = ''; - n_zeilen++; - } + container.style.visibility = 'hidden'; + image.onload = function () { + this.parentNode.style.visibility = 'inherit'; } - schreibe_debugger(" -> " + n_zeilen + " zeilen fuer die Nachbar-Quadratmeter erzeugt"); - return n_zeilen; + image.src = '/contract-image/' + contract.id + '/' + color; + image.width = contract.width * factor; + image.height = contract.height * factor; + + // Falls der Vertrag aus dem angezeigten Bereich herausragt, wird das bild entsprechend geclipped. + container.style.clip + = 'rect(' + + Math.max(0, y_anf - contract.top) * factor + 'px ' + + Math.min(contract.width, contract.width - (contract.left + contract.width - x_anf - 360)) * factor + 'px ' + + Math.min(contract.height, contract.height - (contract.top + contract.height - y_anf - 360)) * factor + 'px ' + + Math.max(0, x_anf - contract.left) * factor + 'px' + + ')'; + + container.style.left = (contract.left - x_anf) * factor + 'px'; + container.style.top = (contract.top - y_anf) * factor + 'px'; + } +function display_selected_contract() +{ + // Anzeigen der ausgew??hlten Nachbarquadratmeter + + if (n_profil.contracts) { + var contract = n_profil.contracts[0]; + + load_contract_image(contract, + document.getElementById('selected_contract_img'), + 1); + load_contract_image(contract, + document.getElementById('lupe_selected_contract_img'), + 5); + } else { + document.getElementById('selected_contract_img').src = '../bilder/spacer.gif'; + document.getElementById('lupe_selected_contract_img').src = '../bilder/spacer.gif'; + } +} + +function display_own_sqm() +{ + var contract = profil.contracts[0]; + var img = document.getElementById('own_contract_img'); + var enlarged_image = document.getElementById('lupe_own_contract_img'); + + load_contract_image(contract, img, 1, "ff0000"); + load_contract_image(contract, enlarged_image, 5, "ff0000"); +} + function qm_zusammenfassen() { // zusammenfassen mehererer Quadratmeterf?hnchen zu einem F?hnchen. - // es wird gepr?ft, ob sich auf der Detailkarte des qm noch mehr qm azeigen lassen dadurch wird die Darstellung der F?hnchen vereinfacht + // es wird gepr?ft, ob sich auf der Detailkarte des qm noch mehr qm anzeigen lassen dadurch wird die Darstellung der F?hnchen vereinfacht + return; + var i=1; while (qm[i]) { var qmV = qm[i]; @@ -499,7 +513,6 @@ } i++; } - icon_versatz(); return true; } @@ -560,20 +573,14 @@ index++; i++; } - var i=1; - while (qm[i]) { - if (qm[i]['status'] == "mitte") { - var qmV = qm[i]; - var uebV = uebersicht_icons[index]; - uebersicht_icons[index] = new Array; - uebersicht_icons[index]['x'] = qmV['x']; - uebersicht_icons[index]['y'] = qmV['y']; - uebersicht_icons[index]['icon'] = "qm"; - uebersicht_icons[index]['name'] = msg("meine m??"); - uebersicht_icons[index]['id'] = i; - } - index++; - i++; + if (profil.contracts) { + var contract = profil.contracts[0]; + uebersicht_icons[index++] = { + x: contract.left, + y: contract.top, + icon: 'qm', + name: msg("meine m??") + }; } var i=1; @@ -584,7 +591,7 @@ var vergleichV_x = uebersicht_icons[j]['x'] + 240; var vergleichV_y = uebersicht_icons[j]['y'] + 240; versatz = kollisonsabfrage(uebV_x + 240, uebV_y + 240, vergleichV_x, vergleichV_y); - // if (versatz[0]) {schreibe_debugger(" -> POI[" + i + "] Richtungsaenderungvorschlag: " + versatz[0]);} + // if (versatz[0]) {dbg(" -> POI[" + i + "] Richtungsaenderungvorschlag: " + versatz[0]);} var test = new Array; test[0] = versatz[0]; var versatz_index = versatz[0] + 1; @@ -595,7 +602,7 @@ versatz_index--; if (versatz_index < 1) {versatz_index = 4;} k++; - // schreibe_debugger(" -> Richtungsaenderungstest bei " + versatz_index + " Fehler: " + richtungsfehler); + // dbg(" -> Richtungsaenderungstest bei " + versatz_index + " Fehler: " + richtungsfehler); if (versatz_index == 1) { richtungsfehler = false; @@ -606,7 +613,7 @@ test = kollisonsabfrage(((uebV_x + 240) + versatz[versatz_index]), (uebV_y + 240) , testV_x, testV_y); if (test[0] != 0) { richtungsfehler = true; - // schreibe_debugger(" -> Kollision mit " + l); + // dbg(" -> Kollision mit " + l); } } } @@ -621,7 +628,7 @@ test = kollisonsabfrage((uebV_x + 240), ((uebV_y + 240) + versatz[versatz_index]), testV_x, testV_y); if (test[0] != 0) { richtungsfehler = true; - // schreibe_debugger(" -> Kollision mit " + l); + // dbg(" -> Kollision mit " + l); } } } @@ -636,7 +643,7 @@ test = kollisonsabfrage(((uebV_x + 240) + versatz[versatz_index]), (uebV_y + 240) , testV_x, testV_y); if (test[0] != 0) { richtungsfehler = true; - // schreibe_debugger(" -> Kollision mit " + l); + // dbg(" -> Kollision mit " + l); } } } @@ -651,7 +658,7 @@ test = kollisonsabfrage((uebV_x + 240), ((uebV_y + 240) + versatz[versatz_index]), testV_x, testV_y); if (test[0] != 0) { richtungsfehler = true; - // schreibe_debugger(" -> Kollision mit " + l); + // dbg(" -> Kollision mit " + l); } } } @@ -664,7 +671,7 @@ if (versatz_index == 2) {uebersicht_icons[i]['y'] = uebersicht_icons[i]['y'] + versatz[versatz_index];} if (versatz_index == 3) {uebersicht_icons[i]['x'] = uebersicht_icons[i]['x'] + versatz[versatz_index];} if (versatz_index == 4) {uebersicht_icons[i]['y'] = uebersicht_icons[i]['y'] + versatz[versatz_index];} - // schreibe_debugger(" -> versetze POI[" + i + "] durch POI[" + j + "] nach " + versatz_index + " um " + versatz[versatz_index] + " "); + // dbg(" -> versetze POI[" + i + "] durch POI[" + j + "] nach " + versatz_index + " um " + versatz[versatz_index] + " "); uebV_x = uebersicht_icons[i]['x']; uebV_y = uebersicht_icons[i]['y']; } @@ -672,11 +679,9 @@ } i++; } - - pkt_erzeugen(); } -function pkt_erzeugen() { +function poi_faehnchen_erzeugen() { // Erzeugen der Faehnchen fuer die POI, der array wird durchlaufen und die entsprechenden Informationen in Ebenen dargestellt var i = 1; while (uebersicht_icons[i]) { @@ -688,8 +693,10 @@ var x = parseInt(Math.round(uebersicht_icons[i]['x'] / 30) + 170 - 8); var y = parseInt(Math.round(uebersicht_icons[i]['y'] / 30) + 101 - 8); - - if (y > 360 + 99 - 13) (y = 360 + 99 -13); + // "aha!" + if (y > 360 + 99 - 13) { + y = 360 + 99 - 13; + } // definieren der Styles neueebene.style.position="absolute"; @@ -702,24 +709,24 @@ neueebene.align = "left"; var faehnchentext = msg(uebersicht_icons[i]['name']); - var index = uebersicht_icons[i]['id']; if (uebersicht_icons[i]['icon'] == "sale") { + var index = uebersicht_icons[i]['id']; neueebene.innerHTML = ''; } else if (uebersicht_icons[i]['icon'] == "qm") { - neueebene.innerHTML = ''; + neueebene.innerHTML = ''; } else { neueebene.innerHTML = ''; } i++; } - schreibe_debugger(" -> " + (i-1) + " Faehnchen erzeugt"); + dbg(" -> " + (i-1) + " Faehnchen erzeugt"); return true; } function poi_pos_setzen(objekt, i) { // qm setzen - schreibe_debugger(" -> Position gestezt"); + dbg(" -> Position gestezt"); var x_obj = parseInt(Math.floor(objekt['x'] - x_anf)); var y_obj = parseInt(Math.floor(objekt['y'] - y_anf)); @@ -738,7 +745,7 @@ function qm_pos_setzen(objekt, i) { // qm setzen - schreibe_debugger(" -> Position gestezt"); + dbg(" -> Position gestezt"); var x_obj = parseInt(Math.floor(objekt['x'] - x_anf)); var y_obj = parseInt(Math.floor(objekt['y'] - y_anf)); @@ -806,6 +813,10 @@ // Ebenen entsprechen ein- oder ausblenden hide_poi_panorama(); hide_poi_luftbild(); + + n_profil = {}; + display_selected_contract(); + show_page("uebersicht"); document.getElementById("qmDetail").style.visibility = "hidden"; document.getElementById("PoiDetail").style.visibility = "hidden"; @@ -813,7 +824,7 @@ document.getElementById("UebersichtPosition").style.visibility = "hidden"; document.getElementById("Ueberschrift").innerHTML = start_ueberschrift; document.getElementById("Untertitel").innerHTML = ""; - schreibe_debugger(" -> Uebersicht anzeigen"); + dbg(" -> Uebersicht anzeigen"); return true; } @@ -924,7 +935,7 @@ x_anf = Math.max(0, Math.round((the_poi['x'] - 180) / 90) * 90); y_anf = Math.min(10440, Math.round((the_poi['y'] - 180) / 90) * 90); - schreibe_debugger(" -> Kacheln laden"); + dbg(" -> Kacheln laden"); // Kacheln von Server holen und dem entsprechenden Bild zuordnen for (var x = 0; x < 4; x++) { for (var y = 0; y < 4; y++) { @@ -958,7 +969,7 @@ // setzen des Positionskaestchens auf der kleinen ?bersichtskarte uebersicht_x = parseInt(((the_poi['x'] / 10800) * 118) + 8); - uebersicht_y = parseInt(((the_poi['y'] / 10800) * 118) + 8); + uebersicht_y = parseInt(((the_poi['y'] / 10800) * 118) + 8) - 37; document.getElementById("UebersichtPosition").style.left = uebersicht_x + "px"; document.getElementById("UebersichtPosition").style.top = uebersicht_y + "px"; @@ -992,7 +1003,7 @@ document.getElementById("Uebersicht").style.visibility = "hidden"; document.getElementById("PoiDetail").style.visibility = "visible"; document.getElementById("UebersichtPosition").style.visibility = "visible"; - schreibe_debugger(" -> POI-Detailansicht anzeigen"); + dbg(" -> POI-Detailansicht anzeigen"); return true; } @@ -1014,7 +1025,7 @@ document.getElementById("PoiInfoText").innerHTML = poi[aktuelles_objekt]['imagetext'][bild - 1]; document.getElementById("Ueberschrift").innerHTML = poi[aktuelles_objekt]['imageueberschrift'][bild - 1]; document.getElementById("Untertitel").innerHTML = poi[aktuelles_objekt]['imageuntertitel'][bild - 1]; - schreibe_debugger(" -> POI-Foto-Detailansicht anzeigen"); + dbg(" -> POI-Foto-Detailansicht anzeigen"); return true; } @@ -1044,17 +1055,19 @@ for (var x = 0; x < 4; x++) { for (var y = 0; y < 4; y++) { - var img = eval("document.qmimg" + (x + 1) + "" + (y + 1)); - img.src = http_pfad + "/overview/" + (x_anf + (x * 90 )) + "/" + (y_anf + (y * 90 )) + "/" + active_layer_names().join("/"); + + var img = document["qmimg" + (x + 1) + "" + (y + 1)]; + img.src = http_pfad + "/overview/" + (x_anf + (x * 90)) + "/" + (y_anf + (y * 90)) + "/" + active_layer_names().join("/"); - var img = eval("document.qmlupe" + (x + 1) + "" + (y + 1)); - img.src = http_pfad + "/overview/" + (x_anf + (x * 90 )) + "/" + (y_anf + (y * 90 )) + "/" + active_layer_names().join("/"); + var img = document["qmlupe" + (x + 1) + "" + (y + 1)]; + img.src = http_pfad + "/overview/" + (x_anf + (x * 90)) + "/" + (y_anf + (y * 90)) + "/" + active_layer_names().join("/"); } } } -function qmDetail_anzeigen(x_koord, y_koord, objekt) { +function qmDetail_anzeigen(x_koord, y_koord, objekt) +{ // Funktion zum Anzeigen der "meine qm" Karte // Funktion zur Anzeige der POIs im Detail aktuelles_objekt = objekt; @@ -1063,20 +1076,21 @@ // alte Kacheln loeschen for (var x = 0; x < 4; x++) { for (var y = 0; y < 4; y++) { - var img = eval("document.img" + (x + 1) + "" + (y + 1)); + var img = document["img" + (x + 1) + "" + (y + 1)]; img.src = "/infosystem/bilder/spacer.gif"; - var img = eval("document.qmlupe" + (x + 1) + "" + (y + 1)); + var img = document["qmlupe" + (x + 1) + "" + (y + 1)]; img.src = "/infosystem/bilder/spacer.gif"; } } - // Koordinaten auf einen geraden Wert innerhalb des Rasters rechen (es sind nur Vielfache von 90 gueltig), - // Startwert der Kacheln ermitteln + // Koordinaten auf einen geraden Wert innerhalb des Rasters + // umrechnen (es sind nur Vielfache von 90 gueltig), Startwert der + // Kacheln ermitteln x_anf = Math.max(0, Math.round((x_koord - 180) / 90) * 90); y_anf = Math.min(10440, Math.round((y_koord - 180) / 90) * 90); - schreibe_debugger(" -> Kacheln laden (" + x_anf + " / " + y_anf + ")"); + dbg(" -> Kacheln laden (" + x_anf + " / " + y_anf + ")"); // Kacheln von Server holen und dem entsprechenden Bild zuordnen load_sqm_tiles(x_anf, y_anf); @@ -1086,24 +1100,14 @@ var loeschen = eval("document.getElementById('qm" + i + "')"); document.getElementById("qmAusschnitt").removeChild(loeschen); } - schreibe_debugger(" -> " + erzeugte_zeilen + " zeilen geloescht"); + dbg(" -> " + erzeugte_zeilen + " zeilen geloescht"); - // fremde Quadratmeter l?schen - if (n_zeilen > 0) { - for (var i = 1; i < n_zeilen; i++) { - var loeschen = eval("document.getElementById('n_qm" + i + "')"); - document.getElementById("qmAusschnitt").removeChild(loeschen); - } - schreibe_debugger(" -> " + n_zeilen + " zeilen geloescht"); - n_zeilen = 0; - } - // qm loeschen for (var i = 1; i <= erzeugte_positionen; i++) { var loeschen = eval("document.getElementById('pos" + i + "')"); document.getElementById("qmDetailKarte").removeChild(loeschen); } - schreibe_debugger(" -> " + erzeugte_positionen + " Positionen geloescht"); + dbg(" -> " + erzeugte_positionen + " Positionen geloescht"); x_obj = parseInt(Math.floor(x_koord - x_anf)); y_obj = parseInt(Math.floor(y_koord - y_anf)); @@ -1125,15 +1129,19 @@ i++; } - schreibe_debugger(" -> " + erzeugte_positionen + " Quadratmeterpositionen"); - schreibe_debugger(" -> " + erzeugte_zeilen + " zeilen fuer Quadratmeter eingezeichnet"); + dbg(" -> " + erzeugte_positionen + " Quadratmeterpositionen"); + dbg(" -> " + erzeugte_zeilen + " zeilen fuer Quadratmeter eingezeichnet"); } // setzen des Positionskaestchens auf der kleinen ?bersichtskarte - var uebersicht_x = parseInt(((x_koord / 10800) * 118) + 14) - var uebersicht_y = parseInt(((y_koord / 10800) * 118 ) + 10) - if (uebersicht_y < 13) {uebersicht_y = 13}; - if (uebersicht_x > 125) {uebersicht_x = 125}; + var uebersicht_x = parseInt(((x_koord / 10800) * 118) + 14); + var uebersicht_y = parseInt(((y_koord / 10800) * 118 ) + 10) - 37; + if (uebersicht_y < 13) { + uebersicht_y = 13; + } + if (uebersicht_x > 125) { + uebersicht_x = 125; + } document.getElementById("UebersichtPosition").style.left = uebersicht_x + "px"; document.getElementById("UebersichtPosition").style.top = uebersicht_y + "px"; @@ -1145,7 +1153,7 @@ + '
' + msg('Land') + ':	' + profil['country'] + '

' + msg('gesponsort') + ':	' + profil['anzahl'] + ' m??
' + msg('seit') + ':	' + qm[aktuelles_objekt]['datum'] + '
' + msg('seit') + ':	' + qm[aktuelles_objekt]['date'] + '

' + profil['nachricht'] + '

- - Ich bin dabei. Ich m??chte sehen wie Samboja Lestari gr??ner wird und schaffe... - -

- - 1 m?? Regenwald [3 Euro], - - - 5 m?? Regenwald [15 Euro], - - - 10 m?? Regenwald [30 Euro], - - - 30 m?? Regenwald [90 Euro] - - - oder - - Quadratmeter [zu je 3 Euro]. - -

- - Ich m??chte die m?? symbolisch verschenken. - - - Info - -
-
-
-
- Spenden sind steuerlich absetzbar! -
-
- - Ich m??chte eine Spendenbescheinigung am Jahresende. -
-
-
-
- - Ihre Daten werden elektronisch ??ber unseren Partner WorldPay erfasst und bearbeitet. - Die Bestimmungen des Datenschutzgesetzes werden eingehalten. Daten werden nicht an Dritte - weitergegeben. - - - - - Datenschutzinformation - -

- - Spenden Sie bequem online via Kreditkarte oder Lastschriftverfahren. - Sie verringern damit administrative Kosten f??r BOS. - - -

- - Ich habe die - - - Verzichtsklausel - gelesen und stimme ihr zu. -
- - -

- - Der Schl??ssel zum Erfolg - die lokale Bev??lkerung - -		- - - zur??ck - -
-	-	-
- Der Naturschutz und die Bed??rfnisse der Bev??lkerung d??rfen sich nicht im Wege stehen. - - Das Naturreservat Samboja Lestari bietet der lokalen Bev??lkerung ein gesichertes Einkommen, Gesundheit - und Bildung. Die Menschen werden in alle Phasen des Projektes mit einbezogen. Landwirtschaft, Baumschule, - Kompostproduktion, Aufforstung, Anpflanzung, Forschung und Aufbau der Infrastruktur bieten sichere Arbeitspl??tze. - -
-
- "Auf diese Weise wird den Menschen eine Alternative geboten, und sie brauchen den Wald nicht mehr zu roden. So k??nnen - wir der Welt zeigen, dass Natur und Menschen zusammenleben k??nnen und einander nicht auszuschlie??en brauchen." - - sagt Dr. Willie Smits, Vorsitzender von BOS Indonesien. - -
-
-
-
-
- Die Sicherheit des Naturschutzreservates ist durch die Akzeptanz der indonesischen Bev??lkerung gew??hrleistet. - Der Erfolg des Projektes garantiert einen besseren Lebensstandard und umgekehrt. -

- - Orang-Utan, Malaienb??r und Nashornvogel - -		- - - zur??ck - -

- Orang-Utans, auch Menschen des Waldes genannt, geh??ren zu den unmittelbar vom Aussterben bedrohten Menschenaffen. - - Orang-Utans geh??ren nicht nur zu unseren nahen Verwandten im Tierreich, sie sind als Samenverbreiter auch unentbehrlich - f??r die Vielfalt des Regenwaldes - sie sind die so genannte Schirmspezies. Somit dient der Schutz dieser faszinierenden - Menschenaffen gleichzeitig auch dem Erhalt des Wald??kosystems. - - Heute leben Orang-Utans nur noch auf Sumatra und Borneo. Massive Regenwaldzerst??rung und skrupelloser Tierhandel - k??nnten bald das Ende ihrer Art bedeuten. Auch die Malaienb??ren verlieren ihren Lebensraum. Das Naturreservat Samboja Lestari - bietet zahlreichen Tieren eine letzte Zuflucht - eine Chance zum ??berleben. Bereits heute leben Malaienb??ren dort in - einem abgegrenzten Areal und in wenigen Jahren k??nnen auch Orang-Utans ein Leben in Freiheit genie??en. - - Seltene Arten wie z.B. Nashornvogel, Zwerghirsch und K??nigskobra k??nnen heute schon wieder in Samboja Lestari beobachtet werden. -

- - - -

- - Landwirtschaft, Aufforstung und Schutz - -

W??hrend der fr??hen Aufforstungs- phase bauen die indonesischen Landwirte gewinnbringende Agrarprodukte zwischen den	- - - -
- neu gepflanzten B??umen an. Landwirtschaft und Aufforstung beeinflussen sich positiv... - - ... - - mehr - -

NEWS im ARCHIV

This is what your RAINFOREST CERTIFICATE will look like:

Imprint

Guide to the Satellite Map

Guide to the Satellite Map

Guide to the Satellite Map

About the satellite map

Infosystem "satellite map"

+ + + NEWS in ARCHIVE + +

My m? in Samboja Lestari - my sponsor profile

Meine m? in Samboja Lestari

Privacy Policy of BOS Deutschland e.V.

Scheme for the "ring"

%%TITLE%%

Ueberweisungsformulardaten:

Ueberweisungsformulardaten:

NEWS im ARCHIV

So sieht Ihre Regenwald-Urkunde aus:

Impressum

Hilfe zur Satellitenkarte

Hilfe zur Satellitenkarte

Hilfe zur Satellitenkarte

Hilfe zur Satellitenkarte

Infosystem "rund um das Satellitenbild"

- - - NEWS im ARCHIV - -

Meine m?? in Samboja Lestari - mein Sponsoren-Profil

Meine ??berweisung f??r das BOS-Projekt "Samboja Lestari"

Meine m?? in Samboja Lestari

Datenschutzgrunds??tze (Privacy Policy) von BOS Deutschland e.V.

Ringschema

Hello Web!

Handler demo

QuickHoney Illustrations

Peter Stemmler

Nana Rausch

Contract-ID	~@[~a~]
Anzahl sqm	~a
Vorname	~@[~a~]
Name	~@[~a~]
Strasse	~@[~a~]
PLZ	~@[~a~]
Ort	~@[~a~]
Email	~@[~a~]
Telefon	~@[~a~]
Contract-ID	~@[~A~]
Anzahl sqm	~A
Vorname	~@[~A~]
Name	~@[~A~]
Strasse	~@[~A~]
PLZ	~@[~A~]
Ort	~@[~A~]
Email	~@[~A~]
Telefon	~@[~A~]

Urkunde per Post	~a
Spendenbescheinigung am Jahresende	~a
Urkunde per Post	~A
Spendenbescheinigung am Jahresende	~A

	- -

	- - Regenwald schaffen - f??r nur 3,- Euro pro m?? - - -
	- Wir freuen uns ??ber Ihre Entscheidung, sich mit BOS f??r Natur und Mensch in Indonesien zu engagieren. - - Mit Ihrer Unterst??tzung leisten Sie einen wichtigen Beitrag zur nachhaltigen Projektarbeit in Samboja Lestari - - - mehr... - -

BOS Foundation

- Die Borneo Orangutan Survival Foundation (BOS) ist die weltweit gr????te Organisation zur Rettung der vom Aussterben bedrohten - Orang-Utans. Ihr Lebensraum, der Regenwald mit seiner Artenvielfalt, wird in Zusammenarbeit mit der lokalen Bev??lkerung gesch??tzt. - BOS ist eine indonesische Nicht-Regierungs-Organisation, die im Jahr 1991 gegr??ndet wurde. - - Die Aufgabenschwerpunkte von BOS in Indonesien sind: - - - - Konfiszierung illegal gehaltener Orang-Utans, Malaienb??ren und anderer Arten - - - Rehabilitation der Orang-Utans in Stationen - - - Auswilderung der Tiere in gesch??tzte Regenwaldgebiete - - - Rettung und Umsiedlung von gef??hrdeten Orang-Utans und anderen Arten - - - Aufforstung und Schutz von Regenwald - - - Schaffung von Alternativen f??r die lokale Bev??lkerung - - - Umweltbildung und Aufkl??rung der lokalen Bev??lkerung - - - ??berwachung von Schutzgebieten - - - Auswertung von Satellitenbildern - - - und vieles mehr. - - - - Die Projekte von BOS werden aufgrund der sehr schwierigen wirtschaftlichen Lage in Indonesien haupts??chlich durch ausl??ndische Spendengelder finanziert. -



M??chten Sie gerne mehr ??ber die Projekte von BOS erfahren? - - - - bos-deutschland.de - - - - - savetheorangutan.info - - -
Dort finden Sie auch Links zu unseren BOS- Schwesterorganisationen weltweit.

Kontakt -			-
-
Wenn Sie Fragen haben, wenden Sie sich an uns! - Wir freuen uns auf Ihre Anregungen und beantworten Ihre Fragen jederzeit gerne. - - BOS Deutschland e.V. - Sch??neberger Ufer 69 - D - 10785 Berlin - - Telefon: +49.30.26 36 78 33 - Fax: +49.30.26 36 78 15 - E-Mail: - - - info at bos-deutschland.de - - - Wir werden alle Anfragen baldm??glichst beantworten. Bitte haben Sie etwas Geduld. - -

-
-
-
M??chten Sie gern mehr ??ber die Projekte von BOS erfahren? - - - - bos-deutschland.de - - - - - savetheorangutan.info - - -
Dort finden Sie auch Links zu unseren BOS- Schwesterorganisationen weltweit. -

- - Samboja Lestari - kreative Aufforstung. - - Eine Zufluchtst??tte f??r Borneo - -		- - zur??ck - -



- BOS schafft durch ein einzigartiges Aufforstungskonzept die vielleicht letzte Zufluchtst??tte f??r Orang-Utans, - Malaienb??ren und andere bedrohte Arten in Borneo. Die Fortschritte k??nnen Sie anhand von Satellitenbildern hier - im Internet beobachten. - - Der ehemals artenreiche Regenwald von - - Samboja Lestari - - wurde in den letzten Jahrzehnten r??cksichtslos gerodet und abgebrannt. N??hrstoffzehrendes Alang-Alang-Gras breitete - sich fl??chendeckend aus. Zur??ck blieb eine ??kologische W??ste. Doch schon heute kann man deutlich erkennen, dass - dies nicht so bleiben muss - denn BOS schafft seit 2001 neuen Regenwald. Das Gebiet von ??ber 17 Millionen m?? wird - durch ein innovatives Aufforstungs- und Schutzkonzept wieder in nat??rlichen Lebensraum verwandelt. Im tropischen - Borneo wachsen Pflanzen um ein Vielfaches schneller als in Europa. Schon in wenigen Jahren k??nnen die ersten - Orang-Utans im neuen Regenwald ausgewildert werden und die Freiheit mit anderen Tieren teilen. In Samboja Lestari - ("ewiges Samboja") entsteht ein Naturschutzgebiet zum dauerhaften Nutzen f??r Menschen, Tiere und Pflanzen. -

- - Ein m??, der es in sich hat - -

- - - -

- Zur Finanzierung des Naturreservates hat BOS ein System zum symbolischen Landkauf entwickelt. - - ... - - mehr - -

- - Landwirtschaft, Aufforstung und Schutz - eine gute Kombination - -		- - zur??ck - -

	-W??hrend der fr??hen Aufforstungsphase bauen die indonesischen Landwirte gewinnbringende Agrarprodukte zwischen den neu gepflanzten B??umen an. Landwirtschaft und Aufforstung beeinflussen sich positiv durch viele Faktoren. - Agrarprodukte sch??tzen die jungen Tropenb??ume vor dem ??berwuchern mit Alang-Alang-Gras. B??ume verbessern die Boden- qualit??t und spenden Schatten. - - Fr??chte wie Papaya und Ananas werden den Bauern garantiert von BOS abgekauft, regional vermarktet oder dienen der Eigenversorgung. Allein f??r die Versorgung der Orang-Utans in der nahe gelegenen Rehabilitationsstation Wanariset werden rund 1000 kg Fr??chte t??glich ben??tigt.

-

Das Schutz(ring)system		- - -

- -Rund um das Naturreservat wird ein Ring aus Zuckerpalmplantagen angelegt. ??ber -650 Familien werden vom Zucker als Hauptprodukt profitieren. Der Ring -sch??tzt das Naturreservat vor den gef??rchteten Waldbr??nden als -Feuerbarriere. Ein innerer Schutzring aus dicht wachsenden, -stacheligen Salakpalmen verhindert das Eindringen von Menschen in das -Schutzgebiet und das Ausbrechen von Orang-Utans. Die Fr??chte der -Salakpalme sind zudem wohlschmeckende Nahrung f??r Mensch und Tier. - -
-Ultraleichtflugzeuge und moderne Satellitentechnik unterst??tzen die st??ndige ??berwachung der BOS-Projekte aus Luft und Weltraum. Illegaler Holzeinschlag sowie Brandrodung k??nnen so auch in Samboja Lestari sehr viel effektiver verfolgt werden. -

Ein m??, der es in sich hat		- - - zur??ck - -

- Zur Finanzierung des Naturreservates hat BOS ein System zum symbolischen Landkauf entwickelt. - - - Schaffen Sie Regenwald f??r nur 3 Euro pro m??! - - -
- Sie finanzieren den Landkauf, ??kologische Aufforstung, eine Baumschule, ??kologische Landwirtschaft, - Zuckerpalmplantagen, L??hne f??r indonesische Mitarbeiter, ??berwachung und Schutz des Gebietes, - Feuerbek??mpfung, Umweltbildung, Infrastruktur, Forschung und Arboretum, Orang-Utan-Inseln und das - Malaienb??rareal. -		- -
- - Leisten Sie einen Beitrag f??r eine bessere Zukunft und beobachten Sie den Projektverlauf von Samboja - Lestari im Internet. Jeder m??, den Sie symbolisch erwerben, wird Ihnen durch ein pers??nliches Profil - zugeordnet. ??ber ein Kennwort k??nnen Sie diese m?? jederzeit leicht wieder finden. - Es k??nnen auch kurze Infotexte "auf" den jeweiligen m?? hinterlassen werden, um sich mit anderen - Regenwaldsponsoren auszutauschen. Besucher dieser Internetseite d??rfen in alle m?? und deren - pers??nliche Profile einblicken. - - Beobachten Sie "Ihre" Fl??che aus unterschiedlichen Perspektiven bei der Entwicklung. BOS bietet Ihnen - einen transparenten Einblick u.a. ??ber Satellitenbilder und berichtet regelm????ig ??ber die - Fortschritte vor Ort. - - Unterst??tzen Sie das Projekt und Sie erhalten eine Regenwald-Urkunde. Sie k??nnen m?? auch an Ihre - Freunde, Verwandten und Bekannten verschenken. - - Machen Sie mit und sehen Sie Regenwald wachsen! - -
-

- - Samboja Lestari - kreative Aufforstung in Borneo. - Eine Zufluchtst??tte f??r bedrohte Tierarten - -

- - - -

-BOS schafft durch ein einzigartiges Aufforstungskonzept die vielleicht -letzte Zufluchtst??tte f??r Orang-Utans, Malaienb??ren und andere -bedrohte Arten in Borneo. Die Fortschritte k??nnen Sie direkt hier im -Internet beobachten. - - ... - - mehr - -

- - Der Schl??ssel zum Erfolg - die lokale Bev??lkerung - -		- - Orang-Utan, Malaienb??r und Nashornvogel - -

- - - -		- - - -

Naturschutz und Bed??rfnisse der Bev??lkerung d??rfen sich nicht im Wege stehen. - - ... - - mehr - -		Orang-Utans geh??ren zu den unmittelbar vom Aussterben bedrohten Menschenaffen. - - ... - - mehr - -

	- -	- Hier befindet sich eine Einrichtung von BOS. -
	- -	- Dieses Icon markiert einen sehensw??rdigen Punkt auf dem Projektgel??nde. -
	- -	- Verkaufsgebiet f??r Quadratmeter, hier k??nnen die Profile der - Quadratmetersponsoren einsehen. -
	- -	- Hier sind "Ihre" Quadratmeter. Dieses Icon wird nur angezeigt, wenn - Sie sich angemeldet haben. -


-	- Bitte ??berpr??fen Sie ggf. vor dem Drucken Ihre Druckereinstellungen. -
		- -

Meine m?? in Samboja Lestari - mein Sponsoren-Profil -
-
Ihre Sponsoren-Profil-Zugangsdaten: -
- Ihre Sponsoren-ID: -	-	- $(sponsor-id) -
- Ihr Kennwort: -	-	- $(sponsor-password_new) -
-
Momentan f??hren wir Ihr Profil unter folgendem angegebenem Namen: -
-
- Name: -	-	- $(name) -
-
- Ihre E-Mail-Adresse wird nicht ver??ffentlicht, sondern lediglich f??r interne Informationszwecke verwendet. -
-
- E-Mail-Adresse: -	-	- $(email) -
-
-
- - - - mail at bosf-deutschland.de - - - - BOS Deutschland e.V. - - - Telefon: +49.30.26 36 78 33 - l - D-10785 Berlin - l - Sch??neberger Ufer 69 - -


Bitte ??berpr??fen Sie ggf. vor dem Drucken Ihre Druckereinstellungen.
		- -

Meine ??berweisung f??r das BOS-Projekt "Samboja Lestari" -

- Ich ??berweise den Betrag von $(Betrag) Euro - auf das Spendenkonto "Samboja Lestari" von BOS Deutschland e.V. - Kontonummer:XXXXXXXXXXX - BLZ:XXXXXXXXXXX - Bank:XXXXXXXXXXXX - Verwendungszweck: $(Transaktionsnummer) - bitte unbedingt auf dem ??berweisungsformular angeben! -

Vorname:		$(vorname)
Name:		$(name)
Stra??e/Nr.:		$(strasse)
PLZ/Ort		$(plz) $(ort)
E-Mail:		$(email)
Telefon:		$(telefon)

- - BOS garantiert: - - Ihre Daten werden lediglich f??r die Reservierung "Ihrer" m2 ben??tigt. - - Die Bestimmungen des Datenschutzgesetzes werden eingehalten. Diese Daten werden nicht an Dritte - weitergegeben. - - - - - Datenschutzinfo - -

- - - - mail at bosf-deutschland.de - - - - - - BOS Deutschland e.V. - - - - - Telefon: +49.30.26 36 78 33 - l - D-10785 Berlin - l - Sch??neberger Ufer 69 - -

Meine m?? in Samboja Lestari -

Die Regenwald-Urkunde wird auf folgenden Namen ausgestellt:
Name:		$(name)
und wird an folgende Adresse versendet:
Adresse:		$(adresse)
Mit dieser Zahlung wurde ein neues Sponsoren-Profil mit der folgenden Sponsoren-ID angelegt: -
Ihre Sponsoren-ID:		$(sponsor-id)


- - - - mail at bosf-deutschland.de - - - - - - BOS Deutschland e.V. - - - - - Telefon: +49.30.26 36 78 33 - l - D-10785 Berlin - l - Sch??neberger Ufer 69 - -




Sponsor-ID	$(sponsor-id)	Vom System zugewiesen
Land	$(country)	Nicht ??nderbar
Name		F??r jeden sichtbar
Neues Kennwort		Bitte zwei mal eingeben
Kennwort-Wiederholung
Info-Text	$(infotext)	Beliebiger Informationstext, f??r jeden sichtbar
Quadratmeter	Insgesamt $(numsqm) Quadratmeter gekauft UTM-Koordinate: N$(sqm-x) E$(sqm-y)
Aktionen	- -	Ihre Profildaten werden mit den eingegeben Werten aktualisiert
	- -	Ihre pers??nlichen Profildaten werden gel??scht
	- -	Alle durchgef??hrten ??nderungen werden verworfen.
		Urkunde als PDF ansehen / downloaden

	- - - Zur??ck - -

-
Richten Sie jetzt Ihr Sponsoren-Profil ein: -
- Ihre Sponsoren-ID: -	-	- $(sponsor-id) -
- Kennwort: -	-	- -
- Kennwort wiederholen: -	-	- -
-
- Momentan f??hren wir Ihr Profil unter unten angegebenem Namen. Sie k??nnen diesen an - dieser Stelle auch ??ndern bzw. angeben, dass Sie anonym bleiben m??chten. -
-
- Name: -	-	- - - anonym -
-
- - Ihre E-Mail-Adresse wird nicht ver??ffentlicht, sondern lediglich f??r - interne Informationszwecke verwendet. -
-
- E-Mail-Adresse: -	-	- -
-
-
-
-
- -

	- -

	Herzlichen Dank
	- f??r Ihre Unterst??tzung und das Vertrauen, das Sie BOS damit entgegen bringen. - - Die von Ihnen gesponserten m?? sind in guten H??nden. -

Ihre Zahlung war erfolgreich:
- -



Auf welchen Namen sollen wir Ihre Regenwald-Urkunde ausstellen?
Name:
- - Wir ??bernehmen den Namen, der in diesem Eingabefeld angegeben wird. - Bitte korrigieren Sie bei Bedarf die angezeigte Eingabe. - -



- -

-
-	- Schaffen Sie Regenwald! - -	-
-	- - - Spenden Sie! - -	-

- - - -


	- Satellitenkarte -

	- - - Es dreht sich um m??. - -
- - - -

	- -

	Herzlichen Dank
	f??r Ihre Unterst??tzung und das Vertrauen, das Sie BOS damit entgegen bringen. Die von Ihnen gesponserten m?? sind in guten H??nden. -

Ihre Zahlung war erfolgreich:
- -



- Bitte geben Sie den Namen des Beschenkten f??r die Urkunde ein: -
- Name: -		- -

- Bitte geben Sie die Versandadresse f??r die Regenwaldurkunde ein. -

Versandadresse f??r die Urkunde:		- -$(name) -$(address) -$(postcode) -$(country) -



- -

Ihre Zahlung war erfolgreich:
- -



- Ist das der Name, der auf der Regenwald-Urkunde als - Sponsor eingetragen werden soll? -
- Name: -		- -

- Bitte ??berpr??fen bzw. korrigieren Sie die angegebene Adresse f??r den Versand - Ihrer Regenwald-Urkunde: -

Versandadresse f??r die Urkunde:		- -$(name) -$(address) -$(country) -



- -

- Wir werden Ihre Regenwald-Urkunde auf den folgenden Namen ausstellen und diese an - die unten angegebene Adresse versenden: - - Name f??r Regenwald-Urkunde: $(name) - - Versandadresse f??r Urkunde: - -$(address) -$(postcode) -$(country) - -
-
- - ??berpr??fen Sie bitte die Richtigkeit der Angaben. - -
-
-
-
- Mit dieser Zahlung wurde ein neues Sponsoren-Profil mit der folgenden Sponsoren-ID angelegt: -
- Ihre Sponsoren-ID: -	-	$(sponsor-id) -
-
-
-
-
- - -