--- /dev/null
+ GNU GENERAL PUBLIC LICENSE
+ Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users. This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it. (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.) You can apply it to
+your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+ To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have. You must make sure that they, too, receive or can get the
+source code. And you must show them these terms so they know their
+rights.
+
+ We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+ Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software. If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+ Finally, any free program is threatened constantly by software
+patents. We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary. To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+\f
+ GNU GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License. The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language. (Hereinafter, translation is included without limitation in
+the term "modification".) Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+ 1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+ 2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+ a) You must cause the modified files to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ b) You must cause any work that you distribute or publish, that in
+ whole or in part contains or is derived from the Program or any
+ part thereof, to be licensed as a whole at no charge to all third
+ parties under the terms of this License.
+
+ c) If the modified program normally reads commands interactively
+ when run, you must cause it, when started running for such
+ interactive use in the most ordinary way, to print or display an
+ announcement including an appropriate copyright notice and a
+ notice that there is no warranty (or else, saying that you provide
+ a warranty) and that users may redistribute the program under
+ these conditions, and telling the user how to view a copy of this
+ License. (Exception: if the Program itself is interactive but
+ does not normally print such an announcement, your work based on
+ the Program is not required to print an announcement.)
+\f
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works. But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+ 3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+ a) Accompany it with the complete corresponding machine-readable
+ source code, which must be distributed under the terms of Sections
+ 1 and 2 above on a medium customarily used for software interchange; or,
+
+ b) Accompany it with a written offer, valid for at least three
+ years, to give any third party, for a charge no more than your
+ cost of physically performing source distribution, a complete
+ machine-readable copy of the corresponding source code, to be
+ distributed under the terms of Sections 1 and 2 above on a medium
+ customarily used for software interchange; or,
+
+ c) Accompany it with the information you received as to the offer
+ to distribute corresponding source code. (This alternative is
+ allowed only for noncommercial distribution and only if you
+ received the program in object code or executable form with such
+ an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it. For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable. However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+\f
+ 4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License. Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+ 5. You are not required to accept this License, since you have not
+signed it. However, nothing else grants you permission to modify or
+distribute the Program or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+ 6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions. You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+ 7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all. For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices. Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+\f
+ 8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded. In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+ 9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time. Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation. If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+ 10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission. For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this. Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+ NO WARRANTY
+
+ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+ END OF TERMS AND CONDITIONS
+\f
+ How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. It is safest
+to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ 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 of the License, 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, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+ Gnomovision version 69, Copyright (C) year name of author
+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary. Here is a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+ `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+ <signature of Ty Coon>, 1 April 1989
+ Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs. If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library. If this is what you want to do, use the GNU Library General
+Public License instead of this License.
--- /dev/null
+UFFI is written and Copyright (c) 2002 by Kevin M. Rosenberg.
+
+UFFI is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License (version 2) as
+published by the Free Software Foundation.
+
+UFFI 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 UFFI; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+
--- /dev/null
+8 Mar 2002
+ - Added ZIP file output with LF->CRLF translations to distribution
+ - Modified def-enum to use uffi:def-constant rather than
+ cl:defconstant
+
--- /dev/null
+Detailed installation instructions are supplied in PDF format
+in the file ./doc/uffi.pdf.
+
--- /dev/null
+# FILE IDENTIFICATION
+#
+# Name: Makefile
+# Purpose: Makefile for the uffi package
+# Programer: Kevin M. Rosenberg, M.D.
+# Date Started: Mar 2002
+#
+# CVS Id: $Id: Makefile,v 1.1 2002/03/09 19:55:33 kevin Exp $
+#
+# Copyright (c) 2002 by Kevin M. Rosenberg
+#
+# This file is part of UFFI.
+#
+# UFFI is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License (version 2) as
+# published by the Free Software Foundation.
+#
+# UFFI 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 UFFI; if not, write to the Free Software Foundation, Inc.,
+# 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+all: nothing
+
+nothing:
+
+clean:
+ @rm -f uffi-*.tar.gz uffi-*.zip
+ @find . -type f -name \*.fasl -exec rm {} \;
+ @find . -type f -name \*.fsl -exec rm {} \;
+ @find . -type d -name .bin |xargs rm -rf
+
+realclean: clean
+ @find . -type f -name \*~ -exec rm {} \;
+ @find . -type f -name "#*#" -exec rm {} \;
+
+doc:
+ (cd doc; make dist-doc)
+
+VERSION=0.1.1
+DISTDIR=uffi-${VERSION}
+DIST_TARBALL=${DISTDIR}.tar.gz
+DIST_ZIP=${DISTDIR}.zip
+SOURCE_FILES=src doc examples Makefile COPYING COPYRIGHT README \
+ INSTALL uffi.lsm ChangeLog NEWS
+
+dist: realclean doc
+ @rm -fr ${DISTDIR} ${DIST_TARBALL} ${DIST_ZIP}
+ @mkdir ${DISTDIR}
+ @cp -a ${SOURCE_FILES} ${DISTDIR}
+ @find ${DISTDIR} -type d -name CVS |xargs rm -rf
+ @tar czf ${DIST_TARBALL} ${DISTDIR}
+ @find ${DISTDIR} -type f -exec unix2dos -q {} \;
+ @zip -rq ${DIST_ZIP} ${DISTDIR}
+ @rm -r ${DISTDIR}
+
+FTP_DIR=/home/ftp/pub/uffi
+
+dist-to-ftp: dist
+ @cp ${DIST_TARBALL} ${DIST_ZIP} ${FTP_DIR}
--- /dev/null
+8 Mar 2002 Intial release of UFFI
+
--- /dev/null
+Package: UFFI (Universal Foreign Language Interface)
+Web site: http://uffi.med-info.com
+Author: Kevin M. Rosenberg
+
+
+BRIEF DESCRIPTION
+-----------------
+uffi is a Common Lisp package for interfacing C-language compatible
+libraries. Every Common Lisp implementation has a method for
+interfacing to such libraries. Unfortunately, these method vary widely
+amongst implementations. uffi gathers a common subset of functionality
+between Common Lisp implementations. uffi wraps this common subset of
+functionality into it's own syntax and provides macro translation of
+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.
+
+
--- /dev/null
+# FILE IDENTIFICATION
+#
+# Name: Makefile
+# Purpose: Makefile for the uffi documentation
+# Programer: Kevin M. Rosenberg
+# Date Started: Mar 2002
+#
+# CVS Id: $Id: Makefile,v 1.1 2002/03/09 19:55:33 kevin Exp $
+#
+# Copyright (c) 2002 by Kevin M. Rosenberg
+#
+# This file is part of UFFI.
+#
+# UFFI is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License (version 2) as
+# published by the Free Software Foundation.
+#
+# UFFI 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 UFFI; if not, write to the Free Software Foundation, Inc.,
+# 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+
+# Set to DSSSL
+# For RedHat 6.x
+#DSSSL_HTML=/usr/lib/sgml/stylesheets/nwalsh-modular/html/docbook.dsl
+#DSSL_PRINT=/usr/lib/sgml/stylesheets/nwalsh-modular/print/docbook.dsl
+
+# For RedHat 7.1
+#DSSSL_HTML=/usr/share/sgml/docbook/dsssl-stylesheets-1.59/html/docbook.dsl
+#DSSSL_PRINT=/usr/share/sgml/docbook/dsssl-stylesheets-1.59/print/docbook.dsl
+
+# For RedHat 7.2
+DSSSL_HTML=/usr/share/sgml/docbook/dsssl-stylesheets-1.64/html/docbook.dsl
+DSSSL_PRINT=/usr/share/sgml/docbook/dsssl-stylesheets-1.64/print/docbook.dsl
+
+# Nothing to configure beyond this point
+
+DOCFILE_BASE_DEFAULT=uffi
+DOCFILE_EXT_DEFAULT=sgml
+
+# Standard docfile processing
+
+ifndef DOCFILE_BASE
+DOCFILE_BASE=${DOCFILE_BASE_DEFAULT}
+endif
+
+ifndef DOCFILE_EXT
+DOCFILE_EXT=${DOCFILE_EXT_DEFAULT}
+endif
+
+DOCFILE=${DOCFILE_BASE}.${DOCFILE_EXT}
+TEXFILE=${DOCFILE_BASE}.tex
+PDFFILE=${DOCFILE_BASE}.pdf
+PSFILE=${DOCFILE_BASE}.ps
+DVIFILE=${DOCFILE_BASE}.dvi
+TMPFILES=${DOCFILE_BASE}.aux ${DOCFILE_BASE}.out ${DOCFILE_BASE}.log
+
+dist-doc: html pdf
+ @rm -f ${DVIFILE} ${PSFILE} ${TEXFILE}
+ @rm *~
+
+all: html pdf ps dvi
+
+check:
+ nsgmls -s -C catalog || exit 1
+
+html: check ${DOCFILE}
+ ( rm -rf html ; mkdir html; cd html ; jade -t sgml -c ../catalog -d ${DSSSL_HTML} ../${DOCFILE}; mv book1.htm manual.htm; cd ..)
+
+tex: ${TEXFILE}
+
+${TEXFILE}: check ${DOCFILE}
+ jade -t tex -c catalog -d ${DSSSL_PRINT} ${DOCFILE}
+
+pdf: ${PDFFILE}
+
+${PDFFILE}: ${TEXFILE}
+ pdfjadetex '\pdfcompresslevel=9' '\input ${TEXFILE}'
+ pdfjadetex '\pdfcompresslevel=9' '\input ${TEXFILE}'
+ pdfjadetex '\pdfcompresslevel=9' '\input ${TEXFILE}'
+ pdfjadetex '\pdfcompresslevel=9' '\input ${TEXFILE}'
+ @rm -f ${TMPFILES}
+
+dvi: ${DVIFILE}
+
+${DVIFILE}: ${TEXFILE}
+ jadetex ${TEXFILE}
+ jadetex ${TEXFILE}
+ jadetex ${TEXFILE}
+ jadetex ${TEXFILE}
+ @rm -f ${TMPFILES}
+
+ps: ${PSFILE}
+
+${PSFILE}: ${DVIFILE}
+ dvips -o ${PSFILE} ${DVIFILE}
+
+clean:
+ @rm -rf html
+ @rm -f ${PSFILE} ${PDFFILE} ${DVIFILE} ${TEXFILE}
+ @rm -f ${TMPFILE}
+
+realclean: clean
+ @rm -f *~
+
+
--- /dev/null
+<!-- -*- DocBook -*- -->
+
+
+ <bookinfo>
+ <title>&uffi; Reference Guide</title>
+ <author>
+ <firstname>Kevin</firstname>
+ <othername>M.</othername>
+ <surname>Rosenberg</surname>
+ <affiliation>
+ <orgname>Heart Hospital of New Mexico</orgname>
+ <address>
+ <email>kevin@rosenberg.net</email>
+ <street>504 Elm Street N.E.</street>
+ <city>Albuquerque</city>
+ <state>New Mexico</state>
+ <postcode>87102</postcode>
+ </address>
+ </affiliation>
+ </author>
+
+ <printhistory>
+ <simpara>$Id: bookinfo.sgml,v 1.1 2002/03/09 19:55:33 kevin Exp $</simpara>
+ <simpara>File $Date: 2002/03/09 19:55:33 $</simpara>
+ </printhistory>
+ <copyright>
+ <year>2002</year>
+ <holder>Kevin M. Rosenberg</holder>
+ </copyright>
+ <legalnotice>
+ <itemizedlist>
+ <listitem>
+ <para>The &uffi; package was designed and
+ written by Kevin M. Rosenberg.
+ </para>
+ </listitem>
+ <listitem>
+ <para><application>Allegro CL</application>® is a registered
+ trademark of Franz Inc.
+ </para>
+ </listitem>
+ <listitem>
+ <para><application>Lispworks</application>® is a registered
+ trademark of Xanalys Inc.
+ </para>
+ </listitem>
+ <listitem>
+ <para><application>Microsoft
+ Windows</application>® is a registered trademark of
+ Microsoft Inc.
+ </para>
+ </listitem>
+ <listitem>
+ <para>Other brand or
+ product names are the registered trademarks or trademarks of
+ their respective holders.
+ </para>
+ </listitem>
+ </itemizedlist>
+ </legalnotice>
+ </bookinfo>
--- /dev/null
+CATALOG /etc/sgml/sgml-docbook-4.1.cat
+DOCUMENT uffi.sgml
--- /dev/null
+<!-- -*- DocBook -*- -->
+
+<chapter>
+ <title>Introduction</title>
+ <sect1>
+ <title>Purpose</title>
+ <para> This reference guide describes
+ &uffi;, a Lisp package that provides persistent cross-implementation
+ support of C-language compatible libraries.
+ </para>
+ </sect1>
+
+ <sect1>
+ <title>Background
+ </title>
+ <para>
+ Every Common Lisp implementation has
+ a method for interfacing to C-language compatible
+ libraries. Unfortunately, these method vary widely amongst
+ implementations. Currently, to support multiple implementations,
+ developers must write a different interface library for each Common
+ Lisp implementation.
+ </para>
+ <para>
+ &uffi; gathers a common subset of functionality between Common Lisp
+ implementations. &uffi; wraps this common subset of functionality with
+ it's own syntax and provides macro translation of uffi functions into
+ the specific syntax of supported Common Lisp implementations.
+ </para>
+ <para>
+ Developers who use &uffi; to interface with C libraries will
+ automatically have their code function in each of uffi's supported
+ implementations.
+ </para>
+ </sect1>
+
+ <sect1>
+ <title>Supported Implementations</title>
+ <para> The primary tested and supported platforms for &uffi; are:
+ </para>
+ <itemizedlist mark="opencircle">
+ <listitem><para>&acl; v6.1 on Redhat Linux 7.2 and Microsoft Windows.</para></listitem>
+ <listitem><para>&lw; v4.2 on Redhat Linux 7.2 and Microsoft Windows.</para></listitem>
+ <listitem><para>&cmucl; 18c on Redhat Linux 7.2.</para></listitem>
+ </itemizedlist>
+ </sect1>
+
+ <sect1>
+ <title>Installation</title>
+ <para>
+ Installation is fairly simple. The main requirement is that you
+ have a copy of &defsystem;. You can download the latest version
+ of &defsystem; from the <ulink
+ url="http://www.sourceforge.net/projects/clocc">
+ <citetitle>CLOCC</citetitle></ulink>
+ CVS tree. After installing &defsystem;, simply
+ <function>push</function> the
+ directory containing &uffi; into
+ <varname>mk:*central-registry*</varname>. Whenever you
+want to load the &uffi; package, use the function
+ <computeroutput>(mk:oos :uffi 'load)</computeroutput>.
+ </para>
+ </sect1>
+</chapter>
--- /dev/null
+<!-- -*- DocBook -*- -->
+
+
+ <chapter>
+ <title>Programming Reference</title>
+
+ <sect1>
+ <title>Design Overview</title>
+ <para>
+ &uffi; was designed as a cross-implementation compatible
+ <emphasis>Foreign Function Interface</emphasis>. Necessarily,
+ only a common subset of functionality can be
+ provided. Likewise, not every optimization for that a specific
+ implementation provides can be supported. Wherever possible,
+ though, implementation-specific optimizations are invoked.
+ </para>
+ </sect1>
+
+ <sect1>
+ <title>Declarations</title>
+ <sect2>
+ <title>Overview</title>
+ <para>Declarations are used to give the compiler optimizing
+ information about foreign types. Currently, only &cmucl;
+ supports declarations. On &acl; and &lw;, these expressions
+ declare the type generically as &t;
+ </para>
+ </sect2>
+
+ <sect2 id="uffi-declare">
+ <title>uffi-declare</title>
+ <para>
+ This is used wherever a <function>declare</function>
+ expression can be placed. For example:
+ </para>
+ <para>
+ <programlisting>
+(let ((my-structure (uffi:allocate-foreign-object 'a-struct)))
+ (uffi:uffi-declare a-struct my-structure))
+ </programlisting>
+ </para>
+ </sect2>
+
+ <sect2 id="slot-type">
+ <title>slot-type</title>
+ <para>
+ This is used inside of <function>defclass</function> and
+ <function>defstruct</function> expressions to set the type
+ for a field. Because the type identifier is not evaluated in
+ &cl;, the expression must be backquoted for effect. For
+ example:
+ </para>
+ <para>
+ <programlisting>
+(eval
+ `(defclass a-class ()
+ ((char-ptr :type ,(uffi:slot-type (* :char))))))
+ </programlisting>
+ </para>
+ </sect2>
+ </sect1>
+
+ <sect1>
+ <title>Immediate Types</title>
+ <sect2>
+ <title>def-constant</title>
+ <para>
+ This is a thin wrapper around
+ <function>defconstant</function>. It also exports the symbol
+ from the package.
+ </para>
+ </sect2>
+ <sect2>
+ <title>def-type</title>
+ <para>
+ This is the main function for creating new types.
+ </para>
+ </sect2>
+ <sect2>
+ <title>null-char-p</title>
+ <para>
+ A predicate testing if a pointer object is &null;
+ </para>
+ </sect2>
+ </sect1>
+
+ <sect1>
+ <title>Aggregate Types</title>
+ <sect2>
+ <title>def-enum</title>
+ <para>
+ Declares a &c; enumeration. It generates constants for the
+ elements of the enumeration.
+ </para>
+ </sect2>
+ <sect2>
+ <title>def-struct</title>
+ <para>
+ Declares a structure.
+ </para>
+ </sect2>
+ <sect2 id="get-slot-value">
+ <title>get-slot-value</title>
+ <para>
+ Accesses a slot value from a structure.
+ </para>
+ </sect2>
+ <sect2>
+ <title>get-slot-pointer</title>
+ <para>
+ This is similar to <function>get-slot-value</function>. It
+ is used when the value of a slot is a pointer type.
+ </para>
+ </sect2>
+ <sect2>
+ <title>def-array</title>
+ <para>
+ Defines an array.
+ </para>
+ </sect2>
+ <sect2>
+ <title>deref-array</title>
+ <para>
+ Accesses an element of an array.
+ </para>
+ </sect2>
+ </sect1>
+
+ <sect1>
+ <title>Objects</title>
+ <sect2>
+ <title>allocate-foreign-object</title>
+ <para>
+ Allocates an instance of a foreign object.
+ </para>
+ </sect2>
+ <sect2>
+ <title>free-foreign-object</title>
+ <para>
+ Frees the memory used by a foreign object.
+ </para>
+ </sect2>
+ <sect2>
+ <title>pointer-address</title>
+ <para>
+ Returns the address as an integer of a pointer.
+ </para>
+ </sect2>
+ <sect2>
+ <title>deref-pointer</title>
+ <para>
+ Returns the object to which a pointer points.
+ </para>
+ </sect2>
+ <sect2>
+ <title>make-null-pointer</title>
+ <para>
+ Creates a &null; pointer of a specified type.
+ </para>
+ </sect2>
+ <sect2>
+ <title>null-pointer-p</title>
+ <para>
+ A predicate testing if a pointer is has a &null; value.
+ </para>
+ </sect2>
+ <sect2>
+ <title>+null-c-string-ptr+</title>
+ <para>
+ A constant returning a &null; character pointer;
+ </para>
+ </sect2>
+ </sect1>
+
+ <sect1>
+ <title>Strings</title>
+ <sect2>
+ <title>convert-from-c-string</title>
+ <para>
+ Converts a Lisp string to a <varname>c-string</varname>.
+ </para>
+ </sect2>
+ <sect2>
+ <title>convert-to-c-string</title>
+ <para>
+ Converts a Lisp string to a
+ <varname>c-string</varname>. These
+ <varname>c-string's</varname> should be freed with
+ <function>free-c-string</function>.
+ </para>
+ </sect2>
+ <sect2>
+ <title>free-c-string</title>
+ <para>
+ Frees any memory possibly allocated by
+ <function>convert-to-c-string</function>.
+ </para>
+ </sect2>
+ <sect2>
+ <title>with-c-string</title>
+ <para>
+ Binds a lexical variable to a newly allocated <varname>c-string</varname>. Automatically frees <varname>c-string</varname>.
+ </para>
+ </sect2>
+ <sect2>
+ <title>covert-from-foreign-string</title>
+ <para>
+ Returns a Lisp string from a foreign string. Has parameters
+ to handle ASCII versus binary strings.
+ </para>
+ </sect2>
+ <sect2>
+ <title>convert-to-foreign-string</title>
+ <para>
+ Converts a Lisp string to a foreign string. Memory should be
+ freed with <function>free-foreign-object</function>.
+ </para>
+ </sect2>
+ <sect2>
+ <title>allocate-foreign-string</title>
+ <para>
+ Allocates space for a foreign string. Memory should
+ be freed with <function>free-foreign-object</function>.
+ </para>
+ </sect2>
+ </sect1>
+
+ <sect1>
+ <title>Routine</title>
+ <sect2>
+ <title>def-routine</title>
+ <para>
+ This macro generates a &c; routine definition.
+ </para>
+ </sect2>
+ </sect1>
+
+ <sect1>
+ <title>Libraries</title>
+ <sect2>
+ <title>load-foreign-library</title>
+ <para>
+ This function loads foreign libraries. It has checks to
+ ensure that a library is loaded only once during a session.
+ </para>
+ </sect2>
+ </sect1>
+
+ </chapter>
+
+
--- /dev/null
+<!-- -*- DocBook -*- -->
+
+<!DOCTYPE BOOK PUBLIC "-//OASIS//DTD DocBook V4.1//EN" [
+<!ENTITY uffi "<application><emphasis>uffi</emphasis></application>">
+<!ENTITY cmucl "<application>CMUCL</application>">
+<!ENTITY lw "<application>Lispworks</application>">
+<!ENTITY acl "<application>AllegroCL</application>">
+<!ENTITY cl "<application>ANSI Common Lisp</application>">
+<!ENTITY t "<constant>T</constant>">
+<!ENTITY nil "<constant>NIL</constant>">
+<!ENTITY null "<constant>NULL</constant>">
+<!ENTITY c "<computeroutput>C</computeroutput>">
+<!ENTITY defsystem "<application>defsystem</application>">
+<!ENTITY bookinfo SYSTEM "bookinfo.sgml">
+<!ENTITY intro SYSTEM "intro.sgml">
+<!ENTITY ref SYSTEM "ref.sgml">
+]>
+
+<book>
+&bookinfo;
+&intro;
+&ref;
+</book>
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: compress.cl
+;;;; Purpose: UFFI Example file for zlib compression
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; Copyright (c) 2002 Kevin M. Rosenberg
+;;;;
+;;;; $Id: compress.cl,v 1.1 2002/03/09 19:55:33 kevin Exp $
+;;;;
+;;;; This file is part of UFFI.
+;;;;
+;;;; UFFI is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License (version 2) as
+;;;; published by the Free Software Foundation.
+;;;;
+;;;; UFFI 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 UFFI; if not, write to the Free Software Foundation, Inc.,
+;;;; 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+(unless (uffi:load-foreign-library "/usr/lib/libz.so" "zlib" '("c"))
+ (warn "Unable to load zlib"))
+
+(uffi:def-routine ("compress" c-compress)
+ ((dest (* :unsigned-char))
+ (destlen (* :long))
+ (source :c-string)
+ (source-len :long))
+ :returning :int
+ :module "zlib")
+
+(defun compress (source)
+ "Returns two values: array of bytes containing the compressed data
+ and the numbe of compressed bytes"
+ (let* ((sourcelen (length source))
+ (destsize (+ 12 (ceiling (* sourcelen 1.01))))
+ (dest (uffi:allocate-foreign-string destsize))
+ (destlen (uffi:allocate-foreign-object :long)))
+ (setf (uffi:deref-pointer destlen :long) destsize)
+ (uffi:with-c-string (source-native source)
+ (let ((result (c-compress dest destlen source-native sourcelen))
+ (newdestlen (uffi:deref-pointer destlen :long)))
+ (unwind-protect
+ (if (zerop result)
+ (values (uffi:convert-from-foreign-string
+ dest
+ :length newdestlen
+ :null-terminated-p nil)
+ newdestlen)
+ (error "zlib error, code ~D" result))
+ (progn
+ (uffi:free-foreign-object destlen)
+ (uffi:free-foreign-object dest)))))))
+
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: getenv.cl
+;;;; Purpose: UFFI Example file to get environment variable
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; Copyright (c) 2002 Kevin M. Rosenberg
+;;;;
+;;;; $Id: getenv.cl,v 1.1 2002/03/09 19:55:33 kevin Exp $
+;;;;
+;;;; This file is part of UFFI.
+;;;;
+;;;; UFFI is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License (version 2) as
+;;;; published by the Free Software Foundation.
+;;;;
+;;;; UFFI 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 UFFI; if not, write to the Free Software Foundation, Inc.,
+;;;; 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+
+(uffi:def-routine ("getenv" c-getenv)
+ ((name :c-string))
+ :returning :c-string)
+
+(defun getenv (key)
+ "Returns an environment variable, or NIL if it does not exist"
+ (check-type key string)
+ (uffi:with-c-string (key-native key)
+ (let ((value-c-string (c-getenv key-native)))
+ (uffi:convert-from-c-string value-c-string))))
+
+(format t "~&Environment value for USER key: ~A" (getenv "USER"))
+(format t "~&Environment value for _FOO_ key: ~A" (getenv "_FOO_"))
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: gethostname.cl
+;;;; Purpose: UFFI Example file to get hostname of system
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; Copyright (c) 2002 Kevin M. Rosenberg
+;;;;
+;;;; $Id: gethostname.cl,v 1.1 2002/03/09 19:55:33 kevin Exp $
+;;;;
+;;;; This file is part of UFFI.
+;;;;
+;;;; UFFI is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License (version 2) as
+;;;; published by the Free Software Foundation.
+;;;;
+;;;; UFFI 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 UFFI; if not, write to the Free Software Foundation, Inc.,
+;;;; 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+
+;;; This example is inspired by the example on the CL-Cookbook web site
+
+(uffi:def-routine ("gethostname" c-gethostname)
+ ((name :c-string)
+ (len :int))
+ :returning :int)
+
+(defun gethostname ()
+ "Returns the hostname"
+ (let* ((name (uffi:allocate-foreign-string 256))
+ (result (c-gethostname name 256)))
+ (unwind-protect
+ (if (zerop result)
+ (uffi:convert-from-foreign-string name)
+ (error "gethostname() failed."))
+ (uffi:free-foreign-object name))))
+
+(format t "~&Hostname: ~A" (gethostname))
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: getshells.cl
+;;;; Purpose: UFFI Example file to get lisp of legal shells
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; Copyright (c) 2002 Kevin M. Rosenberg
+;;;;
+;;;; $Id: getshells.cl,v 1.1 2002/03/09 19:55:33 kevin Exp $
+;;;;
+;;;; This file is part of UFFI.
+;;;;
+;;;; UFFI is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License (version 2) as
+;;;; published by the Free Software Foundation.
+;;;;
+;;;; UFFI 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 UFFI; if not, write to the Free Software Foundation, Inc.,
+;;;; 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+
+(uffi:def-routine "setusershell"
+ nil
+ :returning :void)
+
+(uffi:def-routine "endusershell"
+ nil
+ :returning :void)
+
+(uffi:def-routine "getusershell"
+ nil
+ :returning :c-string)
+
+(defun getshells ()
+ "Returns list of valid shells"
+ (setusershell)
+ (let (shells)
+ (do ((shell (uffi:convert-from-c-string (getusershell))
+ (uffi:convert-from-c-string (getusershell))))
+ ((null shell))
+ (push shell shells))
+ (endusershell)
+ (nreverse shells)))
+
+(format t "~&Shells: ~S" (getshells))
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: getenv.cl
+;;;; Purpose: UFFI Example file to get time
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; Copyright (c) 2002 Kevin M. Rosenberg
+;;;;
+;;;; $Id: gettime.cl,v 1.1 2002/03/09 19:55:33 kevin Exp $
+;;;;
+;;;; This file is part of UFFI.
+;;;;
+;;;; UFFI is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License (version 2) as
+;;;; published by the Free Software Foundation.
+;;;;
+;;;; UFFI 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 UFFI; if not, write to the Free Software Foundation, Inc.,
+;;;; 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+(uffi:def-type time-t :unsigned-long)
+
+(uffi:def-struct tm
+ (sec :int)
+ (min :int)
+ (hour :int)
+ (mday :int)
+ (mon :int)
+ (year :int)
+ (wday :int)
+ (yday :int)
+ (isdst :int))
+
+(uffi:def-routine ("time" c-time)
+ ((time (* time-t)))
+ :returning time-t)
+
+(uffi:def-routine ("localtime" c-localtime)
+ ((time (* time-t)))
+ :returning (* tm))
+
+(defun gettime ()
+ "Returns the local time"
+ (let* ((time (uffi:allocate-foreign-object time-t)))
+ (c-time time)
+ (let* ((tm-ptr (c-localtime time))
+ (time-string (format nil "~2d/~2,'0d/~d ~2d:~2,'0d:~2,'0d"
+ (1+ (uffi:get-slot-value tm-ptr 'mon 'tm))
+ (uffi:get-slot-value tm-ptr 'mday 'tm)
+ (+ 1900 (uffi:get-slot-value tm-ptr 'year 'tm))
+ (uffi:get-slot-value tm-ptr 'hour 'tm)
+ (uffi:get-slot-value tm-ptr 'min 'tm)
+ (uffi:get-slot-value tm-ptr 'sec 'tm)
+ )))
+ (uffi:free-foreign-object time)
+ time-string)
+ ))
+
+(format t "~&~A" (gettime))
+
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: getenv.cl
+;;;; Purpose: UFFI Example file to strtol
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; Copyright (c) 2002 Kevin M. Rosenberg
+;;;;
+;;;; $Id: strtol.cl,v 1.1 2002/03/09 19:55:33 kevin Exp $
+;;;;
+;;;; This file is part of UFFI.
+;;;;
+;;;; UFFI is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License (version 2) as
+;;;; published by the Free Software Foundation.
+;;;;
+;;;; UFFI 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 UFFI; if not, write to the Free Software Foundation, Inc.,
+;;;; 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+(uffi:def-type char-ptr (* :char))
+
+;; This example does not use :c-string to pass the input string since
+;; the routine needs to do pointer arithmetic to see how many characters
+;; were parsed
+
+(uffi:def-routine ("strtol" c-strtol)
+ ((nptr (* :char))
+ (endptr (* char-ptr))
+ (base :int))
+ :returning :long)
+
+(defun strtol (str &optional (base 10))
+ "Returns a long int from a string. Returns number and condition flag.
+Condition flag is T if all of string parses as a long, NIL if
+their was no string at all, or an integer indicating position in string
+of first non-valid character"
+ (let* ((str-native (uffi:convert-to-foreign-string str))
+ (endptr (uffi:allocate-foreign-object char-ptr))
+ (value (c-strtol str-native endptr base))
+ (endptr-value (uffi:deref-pointer endptr 'char-ptr))
+ (next-char-value (uffi:deref-pointer endptr-value :char))
+ (chars-parsed (- (uffi:pointer-address endptr-value)
+ (uffi:pointer-address str-native))))
+ (uffi:free-foreign-object str-native)
+ (uffi:free-foreign-object endptr)
+ (cond
+ ((zerop chars-parsed)
+ (values nil nil))
+ ((uffi:null-char-p next-char-value)
+ (values value t))
+ (t
+ (values value chars-parsed)))))
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: aggregates.cl
+;;;; Purpose: UFFI source to handle aggregate types
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; Copyright (c) 2002 Kevin M. Rosenberg
+;;;;
+;;;; $Id: aggregates.cl,v 1.1 2002/03/09 19:55:33 kevin Exp $
+;;;;
+;;;; This file is part of the UFFI.
+;;;;
+;;;; UFFI is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License (version 2) as
+;;;; published by the Free Software Foundation.
+;;;;
+;;;; UFFI 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 UFFI; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :uffi)
+
+(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))
+ (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 `(uffi:def-constant ,name ,value) constants)))
+ (setf cmds (append '(progn)
+ #+allegro `((ff:def-foreign-type ,enum-name :int))
+ #+lispworks `((fli:define-c-typedef ,enum-name :int))
+ #+cmu `((alien:def-alien-type ,enum-name alien:signed))
+ (nreverse constants)))
+ cmds))
+
+
+(defmacro def-array (name-array type)
+ #+allegro
+ `(ff:def-foreign-type ,name-array
+ (:struct (:my-field (:array ,(convert-from-uffi-type type :array)))))
+ #+lispworks
+ `(fli:define-c-typedef ,name-array
+ (:pointer (:pointer ,(convert-from-uffi-type type :array))))
+ #+cmu
+ `(alien:def-alien-type ,name-array
+ (* ,(convert-from-uffi-type type :array)))
+ )
+
+(defun process-struct-args (name args)
+ (let (processed)
+ (dolist (arg args)
+ (let ((field-name (car arg))
+ (type (cadr arg)))
+ (push (append (list field-name)
+ (if (eq type :pointer-self)
+ #+cmu `((* (alien:struct ,name)))
+ #-cmu `((* ,name))
+ `(,(convert-from-uffi-type type :struct))))
+ processed)))
+ (nreverse processed)))
+
+
+(defmacro def-struct (name &rest args)
+ #+cmu
+ `(alien:def-alien-type ,name (alien:struct ,name ,@(process-struct-args name args)))
+ #+allegro
+ `(ff:def-foreign-type ,name (:struct ,@(process-struct-args name args)))
+ #+lispworks
+ `(fli:define-c-struct ,name ,@(process-struct-args name args))
+ )
+
+
+(defmacro get-slot-value (obj slot type)
+ #+(or lispworks cmu) (declare (ignore type))
+ #+allegro
+ `(ff:fslot-value-typed ,type :c ,obj ,slot)
+ #+lispworks
+ `(fli:foreign-slot-value ,obj ,slot)
+ #+cmu
+ `(alien:slot ,obj ,slot)
+ )
+
+(defmacro get-slot-pointer (obj slot type)
+ #+(or lispworks cmu) (declare (ignore type))
+ #+allegro
+ `(ff:fslot-value-typed ,type :c ,obj ,slot)
+ #+lispworks
+ `(fli:foreign-slot-pointer ,obj ,slot)
+ #+cmu
+ `(alien:slot ,obj ,slot)
+ )
+
+(defmacro deref-array (obj i type)
+ "Returns a field from a row"
+ #+(or lispworks cmu) (declare (ignore type))
+ #+cmu `(alien:deref ,obj ,i)
+ #+lispworks `(fli:dereference ,obj :index ,i)
+ #+allegro `(ff:fslot-value-typed ,type :c ,obj ':my-field ,i)
+ )
+
+
+
+
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: immediates.cl
+;;;; Purpose: UFFI source to handle immediate types
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; Copyright (c) 2002 Kevin M. Rosenberg
+;;;;
+;;;; $Id: immediates.cl,v 1.1 2002/03/09 19:55:33 kevin Exp $
+;;;;
+;;;; This file is part of the UFFI.
+;;;;
+;;;; UFFI is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License (version 2) as
+;;;; published by the Free Software Foundation.
+;;;;
+;;;; UFFI 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 UFFI; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :uffi)
+
+(defmacro def-constant (name value)
+ "Macro to define a constant and to export it"
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defconstant ,name ,value)
+ (export ',name)))
+
+(defmacro uffi-declare (type name)
+ "Generates a declare statement for CL. Currently, only CMUCL
+supports this."
+ #+(or lispworks allegro)
+ (declare (ignore type name))
+ #+cmu
+ `(declare (type (alien ,type) ,name))
+ )
+
+(defmacro slot-type (type)
+ #+(or lispworks allegro)
+ (declare (ignore type))
+ #+(or lispworks allegro)
+ t
+ #+cmu `'(alien:alien ,type))
+
+(defmacro null-char-p (val)
+ `(if (or (eql ,val 0)
+ (eq ,val #\Null))
+ t
+ nil))
+
+
+(defmacro def-type (name type)
+ #+lispworks `(fli:define-c-typedef ,name ,(convert-from-uffi-type type :type))
+ #+allegro `(ff:def-foreign-type ,name ,(convert-from-uffi-type type :type))
+ #+cmu `(alien:def-alien-type ,name ,(convert-from-uffi-type type :type))
+ )
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defvar +type-conversion-hash+ (make-hash-table :size 20))
+ #+cmu (defvar +cmu-def-type-hash+ (make-hash-table :size 20))
+ )
+
+#+cmu
+(defconstant +cmu-def-type-list+
+ '((:char . (alien:signed 8))
+ (:unsigned-char . (alien:unsigned 8))
+ (:short . (alien:signed 16))
+ (:unsigned-short . (alien:unsigned 16))
+ (:int . (alien:signed 32))
+ (:unsigned-int . (alien:unsigned 32))
+ (:long . (alien:signed 32))
+ (:unsigned-long . (alien:unsigned 32))
+ (:float . alien:single-float)
+ (:double . alien:double-float)
+ ))
+
+#+cmu
+(defconstant +type-conversion-list+
+ '((* . *) (:void . c-call:void)
+ (:short . c-call:short)
+ (:pointer-void . (* t))
+ (:c-string . c-call:c-string)
+ (:char . c-call:char) (:unsigned-char . (alien:unsigned 8))
+ (:int . alien:integer) (:unsigned-int . c-call:unsigned-int)
+ (:long . c-call:long) (:unsigned-long . c-call:unsigned-long)
+ (:float . c-call:float) (:double . c-call:double)
+ (:array . alien:array)))
+#+allegro
+(defconstant +type-conversion-list+
+ '((* . *) (:void . :void)
+ (:short . :short)
+ (:pointer-void . (* :void))
+ (:c-string . (* :char))
+ (:char . :char) (:unsigned-char . :unsigned-char)
+ (:int . :int) (:unsigned-int . :unsigned-int)
+ (:long . :long) (:unsigned-long . :unsigned-long)
+ (:float . :float) (:double . :double)
+ (:array . :array)))
+#+lispworks
+(defconstant +type-conversion-list+
+ '((* . :pointer) (:void . :void)
+ (:short . :short)
+ (:pointer-void . (:pointer :void))
+ (:c-string . (:pointer (:unsigned :char)))
+ (:char . :char) (:unsigned-char . (:unsigned :char))
+ (:int . :int) (:unsigned-int . (:unsigned :int))
+ (:long . :long) (:unsigned-long . (:unsigned :long))
+ (:float . :float) (:double . :double)
+ (:array . :c-array)))
+
+(dolist (type +type-conversion-list+)
+ (setf (gethash (car type) +type-conversion-hash+) (cdr type)))
+
+#+cmu
+(dolist (type +cmu-def-type-list+)
+ (setf (gethash (car type) +cmu-def-type-hash+) (cdr type)))
+
+(defun ph (&optional (os *standard-output*))
+ (maphash #'(lambda (k v) (format os "~&~S => ~S" k v)) +type-conversion-hash+))
+
+(defun convert-from-uffi-type (type context)
+ "Converts from a uffi type to an implementation specific type"
+ (if (atom type)
+ (cond
+ #+allegro
+ ((and (or (eq context :routine) (eq context :return))
+ (eq type :c-string))
+ (setq type '((* :char) integer)))
+ #+cmu
+ ((eq context :type)
+ (let ((cmu-type (gethash type +cmu-def-type-hash+)))
+ (if cmu-type
+ cmu-type
+ (let ((found-type (gethash type +type-conversion-hash+)))
+ (if found-type
+ found-type
+ type)))))
+ (t
+ (let ((found-type (gethash type +type-conversion-hash+)))
+ (if found-type
+ found-type
+ type))))
+ (cons (convert-from-uffi-type (first type) context)
+ (convert-from-uffi-type (rest type) context))))
+
+
+
+
+
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: libraries.cl
+;;;; Purpose: UFFI source to load foreign libraries
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; Copyright (c) 2002 Kevin M. Rosenberg
+;;;;
+;;;; $Id: libraries.cl,v 1.1 2002/03/09 19:55:33 kevin Exp $
+;;;;
+;;;; This file is part of the UFFI.
+;;;;
+;;;; UFFI is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License (version 2) as
+;;;; published by the Free Software Foundation.
+;;;;
+;;;; UFFI 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 UFFI; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :uffi)
+
+(defvar *loaded-libraries* nil
+ "List of foreign libraries loaded. Used to prevent reloading a library")
+
+(defun load-foreign-library (filename module supporting-libraries)
+ #+allegro (declare (ignore module supporting-libraries))
+ #+lispworks (declare (ignore supporting-libraries))
+ #+cmu (declare (ignore module))
+
+ (when (and filename (probe-file filename))
+ (if (find filename *loaded-libraries* :test #'string-equal)
+ t ;; return T, but don't reload library
+ (progn
+ #+cmu (alien:load-foreign filename
+ :libraries
+ (convert-supporting-libraries-to-string
+ supporting-libraries))
+ #+lispworks (fli:register-module module :connection-style :automatic
+ :real-name filename)
+ #+allegro (load filename)
+
+ (push filename *loaded-libraries*))))
+ )
+
+(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)))
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: objects.cl
+;;;; Purpose: UFFI source to handle objects and pointers
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; Copyright (c) 2002 Kevin M. Rosenberg
+;;;;
+;;;; $Id: objects.cl,v 1.1 2002/03/09 19:55:33 kevin Exp $
+;;;;
+;;;; This file is part of the UFFI.
+;;;;
+;;;; UFFI is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License (version 2) as
+;;;; published by the Free Software Foundation.
+;;;;
+;;;; UFFI 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 UFFI; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :uffi)
+
+(defmacro allocate-foreign-object (type)
+ #+cmu
+ `(alien:make-alien ,(convert-from-uffi-type type :allocation))
+ #+lispworks
+ `(fli:allocate-foreign-object :type ',(convert-from-uffi-type type :allocate))
+ #+allegro
+ `(ff:allocate-fobject ',(convert-from-uffi-type type :allocate) :c)
+ )
+
+(defmacro free-foreign-object (obj)
+ #+cmu
+ `(alien:free-alien ,obj)
+ #+lispworks
+ `(fli:free-foreign-object ,obj)
+ #+allegro
+ `(ff:free-fobject ,obj)
+ )
+
+(defmacro null-pointer-p (obj)
+ #+lispworks `(fli:null-pointer-p ,obj)
+ #+allegro `(zerop ,obj)
+ #+cmu `(alien:null-alien ,obj)
+ )
+
+(def-constant +null-c-string-pointer+
+ #+cmu nil
+ #+allegro 0
+ #+lispworks (fli:make-pointer :address 0 :type '(:unsigned :char)))
+
+(defmacro make-null-pointer (type)
+ #+(or allegro cmu) (declare (ignore type))
+
+ #+cmu `(system:int-sap 0)
+ #+allegro 0
+ #+lispworks `(fli:make-pointer :address 0 :type ,type)
+ )
+
+(defmacro deref-pointer (ptr type)
+ "Returns a object pointed"
+ #+(or lispworks cmu) (declare (ignore type))
+ #+cmu `(alien:deref ,ptr)
+ #+lispworks `(fli:dereference ,ptr)
+ #+allegro `(ff:fslot-value-typed ,type :c ,ptr)
+ )
+
+(defmacro pointer-address (obj)
+ #+cmu
+ `(system:sap-int (alien:alien-sap ,obj))
+ #+lispworks
+ `(fli:pointer-address ,obj)
+ #+allegro
+ obj
+ )
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: routine.cl
+;;;; Purpose: UFFI source to C function defintions
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; Copyright (c) 2002 Kevin M. Rosenberg
+;;;;
+;;;; $Id: routine.cl,v 1.1 2002/03/09 19:55:33 kevin Exp $
+;;;;
+;;;; This file is part of the UFFI.
+;;;;
+;;;; UFFI is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License (version 2) as
+;;;; published by the Free Software Foundation.
+;;;;
+;;;; UFFI 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 UFFI; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :uffi)
+
+(defun process-function-args (args)
+ (if (null args)
+ #+lispworks nil
+ #+allegro '(:void)
+ #+cmu nil
+ (let (processed)
+ (dolist (arg args)
+ (push (process-one-function-arg arg) processed))
+ (nreverse processed))))
+
+(defun process-one-function-arg (arg)
+ (let ((name (car arg))
+ (type (convert-from-uffi-type (cadr arg) :routine)))
+ #+cmu
+ (list name type :in)
+ #+(or allegro lispworks)
+ (if (and (listp type) (listp (car type)))
+ (append (list name) type)
+ (list name type))
+ ))
+
+(defun allegro-convert-return-type (type)
+ (if (and (listp type) (not (listp (car type))))
+ (list type)
+ type))
+
+;; 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-routine (names args &key module returning)
+ #+(or cmu allegro) (declare (ignore module))
+
+ (let* ((result-type (convert-from-uffi-type returning :return))
+ (function-args (process-function-args args))
+ (foreign-name (if (atom names) names (car names)))
+ (lisp-name (if (atom names) (make-lisp-name names) (cadr names))))
+
+ #+allegro
+ `(ff:def-foreign-call (,lisp-name ,foreign-name)
+ ,function-args
+ :returning ,(allegro-convert-return-type result-type)
+ :call-direct t
+ :strings-convert nil)
+ #+cmu
+ `(alien:def-alien-routine (,foreign-name ,lisp-name)
+ ,result-type
+ ,@function-args)
+ #+lispworks
+ `(fli:define-foreign-function (,lisp-name ,foreign-name :object)
+ ,function-args
+ ,@(if module (list :module module) (values))
+ :calling-convention :cdecl)
+ ))
+
+
+(defun make-lisp-name (name)
+ (let ((converted (substitute #\- #\_ name)))
+ (intern
+ #+case-sensitive converted
+ #-case-sensitive (string-upcase converted))))
+
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: immediates.cl
+;;;; Purpose: UFFI source to handle immediate types
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; Copyright (c) 2002 Kevin M. Rosenberg
+;;;;
+;;;; $Id: strings.cl,v 1.1 2002/03/09 19:55:33 kevin Exp $
+;;;;
+;;;; This file is part of the UFFI.
+;;;;
+;;;; UFFI is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License (version 2) as
+;;;; published by the Free Software Foundation.
+;;;;
+;;;; UFFI 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 UFFI; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :uffi)
+
+
+(defmacro convert-from-c-string (obj)
+ "Converts a string from a c-call. Same as convert-from-foreign-string, except
+that CMU automatically converts strings from c-calls."
+ #+cmu obj
+ #+lispworks
+ (let ((stored (gensym)))
+ `(let ((,stored ,obj))
+ (if (fli:null-pointer-p ,stored)
+ nil
+ (fli:convert-from-foreign-string ,stored))))
+ #+allegro
+ (let ((stored (gensym)))
+ `(let ((,stored ,obj))
+ (if (zerop ,stored)
+ nil
+ (values (excl:native-to-string ,stored)))))
+ )
+
+(defmacro convert-to-c-string (obj)
+ #+lispworks
+ `(if (null ,obj)
+ +null-c-string-ptr+
+ (fli:convert-to-foreign-string ,obj))
+ #+allegro
+ `(if (null ,obj)
+ 0
+ (values (excl:string-to-native ,obj)))
+ #+cmu
+ (declare (ignore obj))
+ )
+
+(defmacro free-c-string (obj)
+ #+lispworks
+ `(unless (fli:null-pointer-p ,obj)
+ (fli:free-foreign-object ,obj))
+ #+allegro
+ `(unless (zerop obj)
+ (ff:free-fobject ,obj))
+ #+cmu
+ (declare (ignore obj))
+ )
+
+;; Either length or null-terminated-p must be non-nil
+(defmacro convert-from-foreign-string (obj &key
+ length
+ (null-terminated-p t))
+ #+allegro
+ `(if (zerop ,obj)
+ nil
+ (values (excl:native-to-string
+ ,obj
+ ,@(if length (list :length length) (values))
+ :truncate (not ,null-terminated-p))))
+ #+lispworks
+ `(if (fli:null-pointer-p ,obj)
+ nil
+ (fli:convert-from-foreign-string
+ ,obj
+ ,@(if length (list :length length) (values))
+ :null-terminated-p ,null-terminated-p
+ :external-format '(:latin-1 :eol-style :lf)))
+ #+cmu
+ `(cmucl-naturalize-c-string (alien:alien-sap ,obj)
+ :length ,length
+ :null-terminated-p ,null-terminated-p)
+ )
+
+(defmacro convert-to-foreign-string (obj)
+ #+lispworks
+ `(if (null ,obj)
+ +null-c-string-ptr+
+ (fli:convert-to-foreign-string ,obj))
+ #+allegro
+ `(if (null ,obj)
+ 0
+ (values (excl:string-to-native ,obj)))
+ #+cmu
+ (let ((size (gensym))
+ (storage (gensym))
+ (i (gensym)))
+ `(when (stringp ,obj)
+ (let* ((,size (length ,obj))
+ (,storage (alien:make-alien char (1+ ,size))))
+ (setq ,storage (alien:cast ,storage (* char)))
+ (dotimes (,i ,size)
+ (declare (fixnum ,i)
+ (optimize (speed 3) (safety 0)))
+ (setf (alien:deref ,storage ,i) (char-code (char ,obj ,i))))
+ (setf (alien:deref ,storage ,size) 0)
+ ,storage)))
+ )
+
+
+(defmacro allocate-foreign-string (size)
+ #+cmu
+ (let ((array-def (gensym)))
+ `(let ((,array-def (list 'alien:array 'c-call:char ,size)))
+ (eval `(alien:cast (alien:make-alien ,,array-def) (* (alien:unsigned 8))))))
+ #+lispworks
+ `(fli:allocate-foreign-object :type '(:unsigned :char) :nelems ,size)
+ #+allegro
+ `(ff:allocate-fobject :char :c ,size)
+ )
+
+(defmacro with-c-string ((foreign-string lisp-string) &body body)
+ #+cmu
+ `(let ((,foreign-string ,lisp-string)) ,@body)
+ #+allegro
+ (let ((acl-native (gensym)))
+ `(excl:with-native-string (,acl-native ,lisp-string)
+ (let ((,foreign-string (if ,lisp-string ,acl-native 0)))
+ ,@body)))
+ #+lispworks
+ (let ((result (gensym)))
+ `(let* ((,foreign-string (convert-to-c-string ,lisp-string))
+ (,result ,@body))
+ (fli:free-foreign-object ,foreign-string)
+ ,result))
+ )
+
+;; Modified from CMUCL's source to handle non-null terminated strings
+#+cmu
+(defun cmucl-naturalize-c-string (sap &key
+ length
+ (null-terminated-p t))
+ (declare (type system:system-area-pointer sap))
+ (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 (system: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)))
+ (kernel:copy-from-system-area sap 0
+ result (* vm:vector-data-offset
+ vm:word-bits)
+ (* length vm:byte-bits))
+ result)))
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: compress.cl
+;;;; Purpose: UFFI Example file for zlib compression
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; Copyright (c) 2002 Kevin M. Rosenberg
+;;;;
+;;;; $Id: compress.cl,v 1.1 2002/03/09 19:55:33 kevin Exp $
+;;;;
+;;;; This file is part of UFFI.
+;;;;
+;;;; UFFI is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License (version 2) as
+;;;; published by the Free Software Foundation.
+;;;;
+;;;; UFFI 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 UFFI; if not, write to the Free Software Foundation, Inc.,
+;;;; 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+(unless (uffi:load-foreign-library "/usr/lib/libz.so" "zlib" '("c"))
+ (warn "Unable to load zlib"))
+
+(uffi:def-routine ("compress" c-compress)
+ ((dest (* :unsigned-char))
+ (destlen (* :long))
+ (source :c-string)
+ (source-len :long))
+ :returning :int
+ :module "zlib")
+
+(defun compress (source)
+ "Returns two values: array of bytes containing the compressed data
+ and the numbe of compressed bytes"
+ (let* ((sourcelen (length source))
+ (destsize (+ 12 (ceiling (* sourcelen 1.01))))
+ (dest (uffi:allocate-foreign-string destsize))
+ (destlen (uffi:allocate-foreign-object :long)))
+ (setf (uffi:deref-pointer destlen :long) destsize)
+ (uffi:with-c-string (source-native source)
+ (let ((result (c-compress dest destlen source-native sourcelen))
+ (newdestlen (uffi:deref-pointer destlen :long)))
+ (unwind-protect
+ (if (zerop result)
+ (values (uffi:convert-from-foreign-string
+ dest
+ :length newdestlen
+ :null-terminated-p nil)
+ newdestlen)
+ (error "zlib error, code ~D" result))
+ (progn
+ (uffi:free-foreign-object destlen)
+ (uffi:free-foreign-object dest)))))))
+
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: getenv.cl
+;;;; Purpose: UFFI Example file to get environment variable
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; Copyright (c) 2002 Kevin M. Rosenberg
+;;;;
+;;;; $Id: getenv.cl,v 1.1 2002/03/09 19:55:33 kevin Exp $
+;;;;
+;;;; This file is part of UFFI.
+;;;;
+;;;; UFFI is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License (version 2) as
+;;;; published by the Free Software Foundation.
+;;;;
+;;;; UFFI 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 UFFI; if not, write to the Free Software Foundation, Inc.,
+;;;; 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+
+(uffi:def-routine ("getenv" c-getenv)
+ ((name :c-string))
+ :returning :c-string)
+
+(defun getenv (key)
+ "Returns an environment variable, or NIL if it does not exist"
+ (check-type key string)
+ (uffi:with-c-string (key-native key)
+ (let ((value-c-string (c-getenv key-native)))
+ (uffi:convert-from-c-string value-c-string))))
+
+(format t "~&Environment value for USER key: ~A" (getenv "USER"))
+(format t "~&Environment value for _FOO_ key: ~A" (getenv "_FOO_"))
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: gethostname.cl
+;;;; Purpose: UFFI Example file to get hostname of system
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; Copyright (c) 2002 Kevin M. Rosenberg
+;;;;
+;;;; $Id: gethostname.cl,v 1.1 2002/03/09 19:55:33 kevin Exp $
+;;;;
+;;;; This file is part of UFFI.
+;;;;
+;;;; UFFI is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License (version 2) as
+;;;; published by the Free Software Foundation.
+;;;;
+;;;; UFFI 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 UFFI; if not, write to the Free Software Foundation, Inc.,
+;;;; 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+
+;;; This example is inspired by the example on the CL-Cookbook web site
+
+(uffi:def-routine ("gethostname" c-gethostname)
+ ((name :c-string)
+ (len :int))
+ :returning :int)
+
+(defun gethostname ()
+ "Returns the hostname"
+ (let* ((name (uffi:allocate-foreign-string 256))
+ (result (c-gethostname name 256)))
+ (unwind-protect
+ (if (zerop result)
+ (uffi:convert-from-foreign-string name)
+ (error "gethostname() failed."))
+ (uffi:free-foreign-object name))))
+
+(format t "~&Hostname: ~A" (gethostname))
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: getshells.cl
+;;;; Purpose: UFFI Example file to get lisp of legal shells
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; Copyright (c) 2002 Kevin M. Rosenberg
+;;;;
+;;;; $Id: getshells.cl,v 1.1 2002/03/09 19:55:33 kevin Exp $
+;;;;
+;;;; This file is part of UFFI.
+;;;;
+;;;; UFFI is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License (version 2) as
+;;;; published by the Free Software Foundation.
+;;;;
+;;;; UFFI 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 UFFI; if not, write to the Free Software Foundation, Inc.,
+;;;; 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+
+(uffi:def-routine "setusershell"
+ nil
+ :returning :void)
+
+(uffi:def-routine "endusershell"
+ nil
+ :returning :void)
+
+(uffi:def-routine "getusershell"
+ nil
+ :returning :c-string)
+
+(defun getshells ()
+ "Returns list of valid shells"
+ (setusershell)
+ (let (shells)
+ (do ((shell (uffi:convert-from-c-string (getusershell))
+ (uffi:convert-from-c-string (getusershell))))
+ ((null shell))
+ (push shell shells))
+ (endusershell)
+ (nreverse shells)))
+
+(format t "~&Shells: ~S" (getshells))
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: getenv.cl
+;;;; Purpose: UFFI Example file to get time
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; Copyright (c) 2002 Kevin M. Rosenberg
+;;;;
+;;;; $Id: gettime.cl,v 1.1 2002/03/09 19:55:33 kevin Exp $
+;;;;
+;;;; This file is part of UFFI.
+;;;;
+;;;; UFFI is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License (version 2) as
+;;;; published by the Free Software Foundation.
+;;;;
+;;;; UFFI 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 UFFI; if not, write to the Free Software Foundation, Inc.,
+;;;; 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+(uffi:def-type time-t :unsigned-long)
+
+(uffi:def-struct tm
+ (sec :int)
+ (min :int)
+ (hour :int)
+ (mday :int)
+ (mon :int)
+ (year :int)
+ (wday :int)
+ (yday :int)
+ (isdst :int))
+
+(uffi:def-routine ("time" c-time)
+ ((time (* time-t)))
+ :returning time-t)
+
+(uffi:def-routine ("localtime" c-localtime)
+ ((time (* time-t)))
+ :returning (* tm))
+
+(defun gettime ()
+ "Returns the local time"
+ (let* ((time (uffi:allocate-foreign-object time-t)))
+ (c-time time)
+ (let* ((tm-ptr (c-localtime time))
+ (time-string (format nil "~2d/~2,'0d/~d ~2d:~2,'0d:~2,'0d"
+ (1+ (uffi:get-slot-value tm-ptr 'mon 'tm))
+ (uffi:get-slot-value tm-ptr 'mday 'tm)
+ (+ 1900 (uffi:get-slot-value tm-ptr 'year 'tm))
+ (uffi:get-slot-value tm-ptr 'hour 'tm)
+ (uffi:get-slot-value tm-ptr 'min 'tm)
+ (uffi:get-slot-value tm-ptr 'sec 'tm)
+ )))
+ (uffi:free-foreign-object time)
+ time-string)
+ ))
+
+(format t "~&~A" (gettime))
+
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: getenv.cl
+;;;; Purpose: UFFI Example file to strtol
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; Copyright (c) 2002 Kevin M. Rosenberg
+;;;;
+;;;; $Id: strtol.cl,v 1.1 2002/03/09 19:55:33 kevin Exp $
+;;;;
+;;;; This file is part of UFFI.
+;;;;
+;;;; UFFI is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License (version 2) as
+;;;; published by the Free Software Foundation.
+;;;;
+;;;; UFFI 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 UFFI; if not, write to the Free Software Foundation, Inc.,
+;;;; 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+(uffi:def-type char-ptr (* :char))
+
+;; This example does not use :c-string to pass the input string since
+;; the routine needs to do pointer arithmetic to see how many characters
+;; were parsed
+
+(uffi:def-routine ("strtol" c-strtol)
+ ((nptr (* :char))
+ (endptr (* char-ptr))
+ (base :int))
+ :returning :long)
+
+(defun strtol (str &optional (base 10))
+ "Returns a long int from a string. Returns number and condition flag.
+Condition flag is T if all of string parses as a long, NIL if
+their was no string at all, or an integer indicating position in string
+of first non-valid character"
+ (let* ((str-native (uffi:convert-to-foreign-string str))
+ (endptr (uffi:allocate-foreign-object char-ptr))
+ (value (c-strtol str-native endptr base))
+ (endptr-value (uffi:deref-pointer endptr 'char-ptr))
+ (next-char-value (uffi:deref-pointer endptr-value :char))
+ (chars-parsed (- (uffi:pointer-address endptr-value)
+ (uffi:pointer-address str-native))))
+ (uffi:free-foreign-object str-native)
+ (uffi:free-foreign-object endptr)
+ (cond
+ ((zerop chars-parsed)
+ (values nil nil))
+ ((uffi:null-char-p next-char-value)
+ (values value t))
+ (t
+ (values value chars-parsed)))))
+
--- /dev/null
+Begin4
+Title: UFFI - Universal Foreign Function Interface
+Version: 2002-0303
+Entered-date: 2002-03-03
+Description: UFFI provides a universal interface to C-compatible libraries from
+ Common Lisp.
+ Includes an interpreter, a compiler, a debugger, a CLOS
+ implementation, a foreign language interface, fast bignums,
+ sockets, and i18n support via gettext.
+ Packages running in CLISP include Maxima, CLX and Garnet.
+Keywords: Lisp, Common Lisp, Foreign Function Interface, Allegro, Lispworks, CMUCL
+Author: kevin@rosenberg.net (Kevin Rosenberg)
+Maintainer: kevin@rosenberg.net (Kevin Rosenberg)
+Primary-site: ftp.sourceforge.net /pub/sourceforge/uffi
+Platforms: AllegroCL, Lispworks, CMUCL, Win32, Linux
+Copying-policy: GNU GPL
+End
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: uffi.system
+;;;; Purpose: Defsystem-3/4 system definition file for UFFI package
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; Copyright (c) 2002 Kevin M. Rosenberg
+;;;;
+;;;; $Id: uffi.system,v 1.1 2002/03/09 19:55:33 kevin Exp $
+;;;;
+;;;; This file is part of UFFI.
+;;;;
+;;;; UFFI is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License (version 2) as
+;;;; published by the Free Software Foundation.
+;;;;
+;;;; UFFI 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 UFFI; if not, write to the Free Software Foundation, Inc.,
+;;;; 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :cl-user)
+
+;;; Setup logical pathname translaton with separate binary directories
+;;; for each implementation
+
+;; push allegro case sensitivity on *features*
+#+allegro
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (if (or (eq excl:*current-case-mode* :case-sensitive-lower)
+ (eq excl:*current-case-mode* :case-sensitive-upper))
+ (pushnew :case-sensitive cl:*features*)
+ (pushnew :case-insensitive cl:*features*)))
+
+(defconstant +uffi-compiler-name+
+ #+(and allegro ics case-sensitive) "acl-modern"
+ #+(and allegro (not ics) case-sensitive) "acl-modern8"
+ #+(and allegro ics (not case-sensitive)) "acl-ansi"
+ #+(and allegro (not ics) (not case-sensitive)) "acl-ansi8"
+ #+lispworks "lispworks"
+ #+clisp "clisp"
+ #+cmu "cmucl"
+ #+sbcl "sbcl"
+ #+corman "corman"
+ #+mcl "mcl"
+ #-(or allegro lispworks clisp cmu sbcl corman mcl) "unknown")
+
+(setf (logical-pathname-translations "UFFI")
+ `(("**;bin;*.*.*" ,(merge-pathnames
+ (make-pathname
+ :name :wild
+ :type :wild
+ :directory
+ (append '(:relative :wild-inferiors
+ ".bin" #.+uffi-compiler-name+)))
+ *load-truename*))
+ ("**;*.*.*" ,(merge-pathnames
+ (make-pathname
+ :name :wild
+ :type :wild
+ :directory '(:relative :wild-inferiors))
+ *load-truename*))))
+
+;;; UFFI system definition
+
+(mk:defsystem :uffi
+ :source-pathname "UFFI:src;"
+ :source-extension "cl"
+ :binary-pathname "UFFI:src;bin;"
+ :components
+ ((:file "package")
+ (:file "immediates" :depends-on ("package"))
+ (:file "strings" :depends-on ("immediates"))
+ (:file "objects" :depends-on ("immediates"))
+ (:file "aggregates" :depends-on ("immediates"))
+ (:file "routine" :depends-on ("immediates"))
+ (:file "libraries" :depends-on ("package")))
+ )
+
+
+
+
+
projects / uffi.git / commitdiff