From: Kevin M. Rosenberg Date: Sat, 9 Mar 2002 19:55:32 +0000 (+0000) Subject: r1518: Initial revision X-Git-Tag: v1.6.1~630 X-Git-Url: http://git.kpe.io/?p=uffi.git;a=commitdiff_plain;h=192193db6e4fbda90a840474d4aa2e8762597927 r1518: Initial revision --- 192193db6e4fbda90a840474d4aa2e8762597927 diff --git a/COPYING b/COPYING new file mode 100644 index 0000000..d60c31a --- /dev/null +++ b/COPYING @@ -0,0 +1,340 @@ + 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. + + 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.) + +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. + + 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. + + 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 + + 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. + + + Copyright (C) + + 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. + + , 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. diff --git a/COPYRIGHT b/COPYRIGHT new file mode 100644 index 0000000..bc8e9dd --- /dev/null +++ b/COPYRIGHT @@ -0,0 +1,16 @@ +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 + + diff --git a/ChangeLog b/ChangeLog new file mode 100644 index 0000000..a2afd22 --- /dev/null +++ b/ChangeLog @@ -0,0 +1,5 @@ +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 + diff --git a/INSTALL b/INSTALL new file mode 100644 index 0000000..eaefb8f --- /dev/null +++ b/INSTALL @@ -0,0 +1,3 @@ +Detailed installation instructions are supplied in PDF format +in the file ./doc/uffi.pdf. + diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..f8fd660 --- /dev/null +++ b/Makefile @@ -0,0 +1,64 @@ +# 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} diff --git a/NEWS b/NEWS new file mode 100644 index 0000000..b002cfe --- /dev/null +++ b/NEWS @@ -0,0 +1,2 @@ +8 Mar 2002 Intial release of UFFI + diff --git a/README b/README new file mode 100644 index 0000000..a250dc1 --- /dev/null +++ b/README @@ -0,0 +1,20 @@ +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. + + diff --git a/doc/Makefile b/doc/Makefile new file mode 100644 index 0000000..ee159bf --- /dev/null +++ b/doc/Makefile @@ -0,0 +1,111 @@ +# 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 *~ + + diff --git a/doc/bookinfo.sgml b/doc/bookinfo.sgml new file mode 100644 index 0000000..e95cf48 --- /dev/null +++ b/doc/bookinfo.sgml @@ -0,0 +1,61 @@ + + + + + &uffi; Reference Guide + + Kevin + M. + Rosenberg + + Heart Hospital of New Mexico +
+ kevin@rosenberg.net + 504 Elm Street N.E. + Albuquerque + New Mexico + 87102 +
+ + + + + $Id: bookinfo.sgml,v 1.1 2002/03/09 19:55:33 kevin Exp $ + File $Date: 2002/03/09 19:55:33 $ + + + 2002 + Kevin M. Rosenberg + + + + + The &uffi; package was designed and + written by Kevin M. Rosenberg. + + + + Allegro CL® is a registered + trademark of Franz Inc. + + + + Lispworks® is a registered + trademark of Xanalys Inc. + + + + Microsoft + Windows® is a registered trademark of + Microsoft Inc. + + + + Other brand or + product names are the registered trademarks or trademarks of + their respective holders. + + + + + diff --git a/doc/catalog b/doc/catalog new file mode 100644 index 0000000..4588500 --- /dev/null +++ b/doc/catalog @@ -0,0 +1,2 @@ +CATALOG /etc/sgml/sgml-docbook-4.1.cat +DOCUMENT uffi.sgml diff --git a/doc/intro.sgml b/doc/intro.sgml new file mode 100644 index 0000000..a42cc8d --- /dev/null +++ b/doc/intro.sgml @@ -0,0 +1,64 @@ + + + + Introduction + + Purpose + This reference guide describes + &uffi;, a Lisp package that provides persistent cross-implementation + support of C-language compatible libraries. + + + + + Background + + + 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. + + + &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. + + + Developers who use &uffi; to interface with C libraries will + automatically have their code function in each of uffi's supported + implementations. + + + + + Supported Implementations + The primary tested and supported platforms for &uffi; are: + + + &acl; v6.1 on Redhat Linux 7.2 and Microsoft Windows. + &lw; v4.2 on Redhat Linux 7.2 and Microsoft Windows. + &cmucl; 18c on Redhat Linux 7.2. + + + + + Installation + + 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 + CLOCC + CVS tree. After installing &defsystem;, simply + push the + directory containing &uffi; into + mk:*central-registry*. Whenever you +want to load the &uffi; package, use the function + (mk:oos :uffi 'load). + + + diff --git a/doc/ref.sgml b/doc/ref.sgml new file mode 100644 index 0000000..549a4eb --- /dev/null +++ b/doc/ref.sgml @@ -0,0 +1,251 @@ + + + + + Programming Reference + + + Design Overview + + &uffi; was designed as a cross-implementation compatible + Foreign Function Interface. 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. + + + + + Declarations + + Overview + 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; + + + + + uffi-declare + + This is used wherever a declare + expression can be placed. For example: + + + +(let ((my-structure (uffi:allocate-foreign-object 'a-struct))) + (uffi:uffi-declare a-struct my-structure)) + + + + + + slot-type + + This is used inside of defclass and + defstruct 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: + + + +(eval + `(defclass a-class () + ((char-ptr :type ,(uffi:slot-type (* :char)))))) + + + + + + + Immediate Types + + def-constant + + This is a thin wrapper around + defconstant. It also exports the symbol + from the package. + + + + def-type + + This is the main function for creating new types. + + + + null-char-p + + A predicate testing if a pointer object is &null; + + + + + + Aggregate Types + + def-enum + + Declares a &c; enumeration. It generates constants for the + elements of the enumeration. + + + + def-struct + + Declares a structure. + + + + get-slot-value + + Accesses a slot value from a structure. + + + + get-slot-pointer + + This is similar to get-slot-value. It + is used when the value of a slot is a pointer type. + + + + def-array + + Defines an array. + + + + deref-array + + Accesses an element of an array. + + + + + + Objects + + allocate-foreign-object + + Allocates an instance of a foreign object. + + + + free-foreign-object + + Frees the memory used by a foreign object. + + + + pointer-address + + Returns the address as an integer of a pointer. + + + + deref-pointer + + Returns the object to which a pointer points. + + + + make-null-pointer + + Creates a &null; pointer of a specified type. + + + + null-pointer-p + + A predicate testing if a pointer is has a &null; value. + + + + +null-c-string-ptr+ + + A constant returning a &null; character pointer; + + + + + + Strings + + convert-from-c-string + + Converts a Lisp string to a c-string. + + + + convert-to-c-string + + Converts a Lisp string to a + c-string. These + c-string's should be freed with + free-c-string. + + + + free-c-string + + Frees any memory possibly allocated by + convert-to-c-string. + + + + with-c-string + + Binds a lexical variable to a newly allocated c-string. Automatically frees c-string. + + + + covert-from-foreign-string + + Returns a Lisp string from a foreign string. Has parameters + to handle ASCII versus binary strings. + + + + convert-to-foreign-string + + Converts a Lisp string to a foreign string. Memory should be + freed with free-foreign-object. + + + + allocate-foreign-string + + Allocates space for a foreign string. Memory should + be freed with free-foreign-object. + + + + + + Routine + + def-routine + + This macro generates a &c; routine definition. + + + + + + Libraries + + load-foreign-library + + This function loads foreign libraries. It has checks to + ensure that a library is loaded only once during a session. + + + + + + + diff --git a/doc/uffi.pdf b/doc/uffi.pdf new file mode 100644 index 0000000..90d7952 Binary files /dev/null and b/doc/uffi.pdf differ diff --git a/doc/uffi.sgml b/doc/uffi.sgml new file mode 100644 index 0000000..50374f4 --- /dev/null +++ b/doc/uffi.sgml @@ -0,0 +1,23 @@ + + +uffi"> +CMUCL"> +Lispworks"> +AllegroCL"> +ANSI Common Lisp"> +T"> +NIL"> +NULL"> +C"> +defsystem"> + + + +]> + + +&bookinfo; +&intro; +&ref; + diff --git a/examples/compress.cl b/examples/compress.cl new file mode 100644 index 0000000..cf3bec4 --- /dev/null +++ b/examples/compress.cl @@ -0,0 +1,66 @@ +;;;; -*- 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))))))) + + diff --git a/examples/getenv.cl b/examples/getenv.cl new file mode 100644 index 0000000..3a565c2 --- /dev/null +++ b/examples/getenv.cl @@ -0,0 +1,46 @@ +;;;; -*- 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_")) + diff --git a/examples/gethostname.cl b/examples/gethostname.cl new file mode 100644 index 0000000..4916ed3 --- /dev/null +++ b/examples/gethostname.cl @@ -0,0 +1,51 @@ +;;;; -*- 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)) + diff --git a/examples/getshells.cl b/examples/getshells.cl new file mode 100644 index 0000000..92ecc8b --- /dev/null +++ b/examples/getshells.cl @@ -0,0 +1,57 @@ +;;;; -*- 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)) + diff --git a/examples/gettime.cl b/examples/gettime.cl new file mode 100644 index 0000000..a26e57e --- /dev/null +++ b/examples/gettime.cl @@ -0,0 +1,72 @@ +;;;; -*- 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)) + + diff --git a/examples/strtol.cl b/examples/strtol.cl new file mode 100644 index 0000000..8505422 --- /dev/null +++ b/examples/strtol.cl @@ -0,0 +1,65 @@ +;;;; -*- 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))))) + diff --git a/src/aggregates.cl b/src/aggregates.cl new file mode 100644 index 0000000..b0438d9 --- /dev/null +++ b/src/aggregates.cl @@ -0,0 +1,129 @@ +;;;; -*- 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) + ) + + + + + diff --git a/src/immediates.cl b/src/immediates.cl new file mode 100644 index 0000000..b22a47b --- /dev/null +++ b/src/immediates.cl @@ -0,0 +1,160 @@ +;;;; -*- 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)))) + + + + + + diff --git a/src/libraries.cl b/src/libraries.cl new file mode 100644 index 0000000..21867d1 --- /dev/null +++ b/src/libraries.cl @@ -0,0 +1,60 @@ +;;;; -*- 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))) diff --git a/src/objects.cl b/src/objects.cl new file mode 100644 index 0000000..a114b65 --- /dev/null +++ b/src/objects.cl @@ -0,0 +1,85 @@ +;;;; -*- 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 + ) diff --git a/src/routine.cl b/src/routine.cl new file mode 100644 index 0000000..ddbc4db --- /dev/null +++ b/src/routine.cl @@ -0,0 +1,93 @@ +;;;; -*- 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)))) + + diff --git a/src/strings.cl b/src/strings.cl new file mode 100644 index 0000000..6eeea2c --- /dev/null +++ b/src/strings.cl @@ -0,0 +1,178 @@ +;;;; -*- 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))) diff --git a/tests/compress.cl b/tests/compress.cl new file mode 100644 index 0000000..cf3bec4 --- /dev/null +++ b/tests/compress.cl @@ -0,0 +1,66 @@ +;;;; -*- 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))))))) + + diff --git a/tests/getenv.cl b/tests/getenv.cl new file mode 100644 index 0000000..3a565c2 --- /dev/null +++ b/tests/getenv.cl @@ -0,0 +1,46 @@ +;;;; -*- 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_")) + diff --git a/tests/gethostname.cl b/tests/gethostname.cl new file mode 100644 index 0000000..4916ed3 --- /dev/null +++ b/tests/gethostname.cl @@ -0,0 +1,51 @@ +;;;; -*- 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)) + diff --git a/tests/getshells.cl b/tests/getshells.cl new file mode 100644 index 0000000..92ecc8b --- /dev/null +++ b/tests/getshells.cl @@ -0,0 +1,57 @@ +;;;; -*- 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)) + diff --git a/tests/gettime.cl b/tests/gettime.cl new file mode 100644 index 0000000..a26e57e --- /dev/null +++ b/tests/gettime.cl @@ -0,0 +1,72 @@ +;;;; -*- 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)) + + diff --git a/tests/strtol.cl b/tests/strtol.cl new file mode 100644 index 0000000..8505422 --- /dev/null +++ b/tests/strtol.cl @@ -0,0 +1,65 @@ +;;;; -*- 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))))) + diff --git a/uffi.lsm b/uffi.lsm new file mode 100644 index 0000000..db86190 --- /dev/null +++ b/uffi.lsm @@ -0,0 +1,17 @@ +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 diff --git a/uffi.system b/uffi.system new file mode 100644 index 0000000..f5c5ba7 --- /dev/null +++ b/uffi.system @@ -0,0 +1,92 @@ +;;;; -*- 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"))) + ) + + + + +